diff --git a/src/Docs/Search/ModuleParser.purs b/src/Docs/Search/ModuleParser.purs new file mode 100644 index 0000000..ab9df3f --- /dev/null +++ b/src/Docs/Search/ModuleParser.purs @@ -0,0 +1,50 @@ +module Docs.Search.ModuleParser where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Either (hush) +import Data.Foldable (intercalate) +import Data.Maybe (Maybe) +import Data.Newtype (wrap) +import Docs.Search.Types (ModuleName) +import StringParser (Parser, char, choice, fix, many, manyTill, noneOf, regex, runParser, sepBy, sepBy1, string, try, whiteSpace) + +parseModuleName :: String -> Maybe ModuleName +parseModuleName = map wrap <<< hush <<< runParser do + void $ many whiteSpaceOrComment + moduleHeader + +whiteSpaceOrComment :: Parser Unit +whiteSpaceOrComment = + choice + [ try $ multiLineComment + , try $ singleLineComment + , try $ void whiteSpace + ] + +multiLineComment :: Parser Unit +multiLineComment = do + void $ string "{-" + void $ manyTill (void $ noneOf []) (string "-}") + +singleLineComment :: Parser Unit +singleLineComment = do + void $ string "--" + void $ manyTill (void $ noneOf ['\n']) (char '\n') + + +moduleHeader :: Parser String +moduleHeader = do + void $ string "module" + void $ many whiteSpaceOrComment + moduleName + +moduleName :: Parser String +moduleName = sepBy1 moduleNameWord (string ".") <#> intercalate "." + +moduleNameWord :: Parser String +moduleNameWord = do + first <- regex "[A-Z]" + rest <- regex "[a-z0-9]*" + pure $ first <> rest diff --git a/src/Docs/Search/Types.purs b/src/Docs/Search/Types.purs index 9172edb..5cfa11e 100644 --- a/src/Docs/Search/Types.purs +++ b/src/Docs/Search/Types.purs @@ -31,6 +31,9 @@ derive newtype instance ordModuleName :: Ord ModuleName derive newtype instance decodeJsonModuleName :: DecodeJson ModuleName derive newtype instance encodeJsonModuleName :: EncodeJson ModuleName +instance Show ModuleName where + show = genericShow + -- | Non-normalized package name, e.g. `purescript-prelude` or just `prelude`. newtype RawPackageName = RawPackageName String @@ -55,14 +58,14 @@ data PackageInfo = LocalPackage | Builtin | Package PackageName | UnknownPackage derive instance eqPackageInfo :: Eq PackageInfo derive instance ordPackageInfo :: Ord PackageInfo derive instance genericPackageInfo :: Generic PackageInfo _ -instance showPackageInfo :: Show PackageInfo where - show = genericShow - instance decodeJsonPackageInfo :: DecodeJson PackageInfo where decodeJson = genericDecodeJson instance encodeJsonPackageInfo :: EncodeJson PackageInfo where encodeJson = genericEncodeJson +instance showPackageInfo :: Show PackageInfo where + show = genericShow + newtype PackageScore = PackageScore Int diff --git a/test/Main.purs b/test/Main.purs index dfc2a63..01a01d8 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,16 +3,16 @@ module Test.Main where import Prelude import Effect (Effect) +import Effect.Aff (launchAff_) import Test.Declarations as Declarations import Test.IndexBuilder as IndexBuilder import Test.ModuleIndex as ModuleIndex -import Test.TypeQuery as TypeQuery -import Test.TypeJson as TypeJson --- import Test.UI as UI +import Test.ModuleParser as ModuleParser import Test.Spec (Spec) import Test.Spec.Reporter.Console (consoleReporter) import Test.Spec.Runner (runSpec) -import Effect.Aff (launchAff_) +import Test.TypeJson as TypeJson +import Test.TypeQuery as TypeQuery main :: Effect Unit main = do @@ -21,6 +21,7 @@ main = do mainTest :: Spec Unit mainTest = do + ModuleParser.tests TypeQuery.tests TypeJson.tests IndexBuilder.tests diff --git a/test/Test/ModuleParser.purs b/test/Test/ModuleParser.purs new file mode 100644 index 0000000..2999355 --- /dev/null +++ b/test/Test/ModuleParser.purs @@ -0,0 +1,42 @@ +module Test.ModuleParser where + +import Prelude + +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Docs.Search.ModuleParser (multiLineComment, parseModuleName, singleLineComment) +import Docs.Search.Types (ModuleName(..)) +import StringParser (runParser) +import Test.Spec (Spec, describe, it) +import Test.Spec.Assertions (shouldEqual) + + +tests :: Spec Unit +tests = do + describe "ModuleParser" do + it "test #0" do + parseModuleName "module Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #1" do + parseModuleName "module Foo.Bar.B" `shouldEqual` Just (ModuleName "Foo.Bar.B") + it "test #2" do + parseModuleName " module Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #3" do + parseModuleName " {- asdas -} module Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #4" do + parseModuleName "{--}module Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #5" do + parseModuleName "--\nmodule Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #6" do + parseModuleName "--\n-- foo\nmodule Foo" `shouldEqual` Just (ModuleName "Foo") + it "test #7" do + parseModuleName "-- \n -- foo\n {- bar -} --baz\n module Foo" `shouldEqual` Just (ModuleName "Foo") + it "multiline comment #1" do + runParser multiLineComment "{--}" `shouldEqual` Right unit + it "multiline comment #1" do + runParser multiLineComment "{- foo -}" `shouldEqual` Right unit + it "multiline comment #1" do + runParser multiLineComment "{- foo\nbar\nbar\n -}" `shouldEqual` Right unit + it "single line comment #1" do + runParser singleLineComment "-- asd\n" `shouldEqual` Right unit + it "single line comment #1" do + runParser singleLineComment "--\n" `shouldEqual` Right unit