git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
Add a ModuleParser
commit7593b0110f0018cf8a4f3f8d88d77d12a42871be authorVladimir Kalnitsky <klntsky@gmail.com> dateWed 31 Aug 2022, 20:16 (4 years ago) parente92258b
4 files changed+103−7
compare with master
unifiedsplit
src/Docs/Search/ModuleParser.purs+50 src/Docs/Search/Types.purs+6−3 test/Main.purs+5−4 test/Test/ModuleParser.purs+42
src/Docs/Search/ModuleParser.pursnew file+50
@@ -0,0 +1,50 @@
1+module Docs.Search.ModuleParser where
2+
3+import Prelude
4+
5+import Control.Alt ((<|>))
6+import Data.Either (hush)
7+import Data.Foldable (intercalate)
8+import Data.Maybe (Maybe)
9+import Data.Newtype (wrap)
10+import Docs.Search.Types (ModuleName)
11+import StringParser (Parser, char, choice, fix, many, manyTill, noneOf, regex, runParser, sepBy, sepBy1, string, try, whiteSpace)
12+
13+parseModuleName :: String -> Maybe ModuleName
14+parseModuleName = map wrap <<< hush <<< runParser do
15+ void $ many whiteSpaceOrComment
16+ moduleHeader
17+
18+whiteSpaceOrComment :: Parser Unit
19+whiteSpaceOrComment =
20+ choice
21+ [ try $ multiLineComment
22+ , try $ singleLineComment
23+ , try $ void whiteSpace
24+ ]
25+
26+multiLineComment :: Parser Unit
27+multiLineComment = do
28+ void $ string "{-"
29+ void $ manyTill (void $ noneOf []) (string "-}")
30+
31+singleLineComment :: Parser Unit
32+singleLineComment = do
33+ void $ string "--"
34+ void $ manyTill (void $ noneOf ['\n']) (char '\n')
35+
36+
37+moduleHeader :: Parser String
38+moduleHeader = do
39+ void $ string "module"
40+ void $ many whiteSpaceOrComment
41+ moduleName
42+
43+moduleName :: Parser String
44+moduleName = sepBy1 moduleNameWord (string ".") <#> intercalate "."
45+
46+moduleNameWord :: Parser String
47+moduleNameWord = do
48+ first <- regex "[A-Z]"
49+ rest <- regex "[a-z0-9]*"
50+ pure $ first <> rest
src/Docs/Search/Types.purs+6−3
@@ -31,6 +31,9 @@ derive newtype instance ordModuleName :: Ord ModuleName
3131derive newtype instance decodeJsonModuleName :: DecodeJson ModuleName
3232derive newtype instance encodeJsonModuleName :: EncodeJson ModuleName
3333
34+instance Show ModuleName where
35+ show = genericShow
36+
3437
3538-- | Non-normalized package name, e.g. `purescript-prelude` or just `prelude`.
3639newtype RawPackageName = RawPackageName String
@@ -55,14 +58,14 @@ data PackageInfo = LocalPackage | Builtin | Package PackageName | UnknownPackage
5558derive instance eqPackageInfo :: Eq PackageInfo
5659derive instance ordPackageInfo :: Ord PackageInfo
5760derive instance genericPackageInfo :: Generic PackageInfo _
58−instance showPackageInfo :: Show PackageInfo where
59− show = genericShow
60−
6161instance decodeJsonPackageInfo :: DecodeJson PackageInfo where
6262 decodeJson = genericDecodeJson
6363instance encodeJsonPackageInfo :: EncodeJson PackageInfo where
6464 encodeJson = genericEncodeJson
6565
66+instance showPackageInfo :: Show PackageInfo where
67+ show = genericShow
68+
6669
6770newtype PackageScore = PackageScore Int
6871
test/Main.purs+5−4
@@ -3,16 +3,16 @@ module Test.Main where
33import Prelude
44
55import Effect (Effect)
6+import Effect.Aff (launchAff_)
67import Test.Declarations as Declarations
78import Test.IndexBuilder as IndexBuilder
89import Test.ModuleIndex as ModuleIndex
9−import Test.TypeQuery as TypeQuery
10−import Test.TypeJson as TypeJson
11−-- import Test.UI as UI
10+import Test.ModuleParser as ModuleParser
1211import Test.Spec (Spec)
1312import Test.Spec.Reporter.Console (consoleReporter)
1413import Test.Spec.Runner (runSpec)
15−import Effect.Aff (launchAff_)
14+import Test.TypeJson as TypeJson
15+import Test.TypeQuery as TypeQuery
1616
1717main :: Effect Unit
1818main = do
@@ -21,6 +21,7 @@ main = do
2121
2222mainTest :: Spec Unit
2323mainTest = do
24+ ModuleParser.tests
2425 TypeQuery.tests
2526 TypeJson.tests
2627 IndexBuilder.tests
test/Test/ModuleParser.pursnew file+42
@@ -0,0 +1,42 @@
1+module Test.ModuleParser where
2+
3+import Prelude
4+
5+import Data.Either (Either(..))
6+import Data.Maybe (Maybe(..))
7+import Docs.Search.ModuleParser (multiLineComment, parseModuleName, singleLineComment)
8+import Docs.Search.Types (ModuleName(..))
9+import StringParser (runParser)
10+import Test.Spec (Spec, describe, it)
11+import Test.Spec.Assertions (shouldEqual)
12+
13+
14+tests :: Spec Unit
15+tests = do
16+ describe "ModuleParser" do
17+ it "test #0" do
18+ parseModuleName "module Foo" `shouldEqual` Just (ModuleName "Foo")
19+ it "test #1" do
20+ parseModuleName "module Foo.Bar.B" `shouldEqual` Just (ModuleName "Foo.Bar.B")
21+ it "test #2" do
22+ parseModuleName " module Foo" `shouldEqual` Just (ModuleName "Foo")
23+ it "test #3" do
24+ parseModuleName " {- asdas -} module Foo" `shouldEqual` Just (ModuleName "Foo")
25+ it "test #4" do
26+ parseModuleName "{--}module Foo" `shouldEqual` Just (ModuleName "Foo")
27+ it "test #5" do
28+ parseModuleName "--\nmodule Foo" `shouldEqual` Just (ModuleName "Foo")
29+ it "test #6" do
30+ parseModuleName "--\n-- foo\nmodule Foo" `shouldEqual` Just (ModuleName "Foo")
31+ it "test #7" do
32+ parseModuleName "-- \n -- foo\n {- bar -} --baz\n module Foo" `shouldEqual` Just (ModuleName "Foo")
33+ it "multiline comment #1" do
34+ runParser multiLineComment "{--}" `shouldEqual` Right unit
35+ it "multiline comment #1" do
36+ runParser multiLineComment "{- foo -}" `shouldEqual` Right unit
37+ it "multiline comment #1" do
38+ runParser multiLineComment "{- foo\nbar\nbar\n -}" `shouldEqual` Right unit
39+ it "single line comment #1" do
40+ runParser singleLineComment "-- asd\n" `shouldEqual` Right unit
41+ it "single line comment #1" do
42+ runParser singleLineComment "--\n" `shouldEqual` Right unit