mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-09-11 12:35:37 +03:00
Add a ModuleParser
This commit is contained in:
parent
e92258bdd2
commit
7593b0110f
50
src/Docs/Search/ModuleParser.purs
Normal file
50
src/Docs/Search/ModuleParser.purs
Normal file
@ -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
|
@ -31,6 +31,9 @@ derive newtype instance ordModuleName :: Ord ModuleName
|
|||||||
derive newtype instance decodeJsonModuleName :: DecodeJson ModuleName
|
derive newtype instance decodeJsonModuleName :: DecodeJson ModuleName
|
||||||
derive newtype instance encodeJsonModuleName :: EncodeJson ModuleName
|
derive newtype instance encodeJsonModuleName :: EncodeJson ModuleName
|
||||||
|
|
||||||
|
instance Show ModuleName where
|
||||||
|
show = genericShow
|
||||||
|
|
||||||
|
|
||||||
-- | Non-normalized package name, e.g. `purescript-prelude` or just `prelude`.
|
-- | Non-normalized package name, e.g. `purescript-prelude` or just `prelude`.
|
||||||
newtype RawPackageName = RawPackageName String
|
newtype RawPackageName = RawPackageName String
|
||||||
@ -55,14 +58,14 @@ data PackageInfo = LocalPackage | Builtin | Package PackageName | UnknownPackage
|
|||||||
derive instance eqPackageInfo :: Eq PackageInfo
|
derive instance eqPackageInfo :: Eq PackageInfo
|
||||||
derive instance ordPackageInfo :: Ord PackageInfo
|
derive instance ordPackageInfo :: Ord PackageInfo
|
||||||
derive instance genericPackageInfo :: Generic PackageInfo _
|
derive instance genericPackageInfo :: Generic PackageInfo _
|
||||||
instance showPackageInfo :: Show PackageInfo where
|
|
||||||
show = genericShow
|
|
||||||
|
|
||||||
instance decodeJsonPackageInfo :: DecodeJson PackageInfo where
|
instance decodeJsonPackageInfo :: DecodeJson PackageInfo where
|
||||||
decodeJson = genericDecodeJson
|
decodeJson = genericDecodeJson
|
||||||
instance encodeJsonPackageInfo :: EncodeJson PackageInfo where
|
instance encodeJsonPackageInfo :: EncodeJson PackageInfo where
|
||||||
encodeJson = genericEncodeJson
|
encodeJson = genericEncodeJson
|
||||||
|
|
||||||
|
instance showPackageInfo :: Show PackageInfo where
|
||||||
|
show = genericShow
|
||||||
|
|
||||||
|
|
||||||
newtype PackageScore = PackageScore Int
|
newtype PackageScore = PackageScore Int
|
||||||
|
|
||||||
|
@ -3,16 +3,16 @@ module Test.Main where
|
|||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Effect (Effect)
|
import Effect (Effect)
|
||||||
|
import Effect.Aff (launchAff_)
|
||||||
import Test.Declarations as Declarations
|
import Test.Declarations as Declarations
|
||||||
import Test.IndexBuilder as IndexBuilder
|
import Test.IndexBuilder as IndexBuilder
|
||||||
import Test.ModuleIndex as ModuleIndex
|
import Test.ModuleIndex as ModuleIndex
|
||||||
import Test.TypeQuery as TypeQuery
|
import Test.ModuleParser as ModuleParser
|
||||||
import Test.TypeJson as TypeJson
|
|
||||||
-- import Test.UI as UI
|
|
||||||
import Test.Spec (Spec)
|
import Test.Spec (Spec)
|
||||||
import Test.Spec.Reporter.Console (consoleReporter)
|
import Test.Spec.Reporter.Console (consoleReporter)
|
||||||
import Test.Spec.Runner (runSpec)
|
import Test.Spec.Runner (runSpec)
|
||||||
import Effect.Aff (launchAff_)
|
import Test.TypeJson as TypeJson
|
||||||
|
import Test.TypeQuery as TypeQuery
|
||||||
|
|
||||||
main :: Effect Unit
|
main :: Effect Unit
|
||||||
main = do
|
main = do
|
||||||
@ -21,6 +21,7 @@ main = do
|
|||||||
|
|
||||||
mainTest :: Spec Unit
|
mainTest :: Spec Unit
|
||||||
mainTest = do
|
mainTest = do
|
||||||
|
ModuleParser.tests
|
||||||
TypeQuery.tests
|
TypeQuery.tests
|
||||||
TypeJson.tests
|
TypeJson.tests
|
||||||
IndexBuilder.tests
|
IndexBuilder.tests
|
||||||
|
42
test/Test/ModuleParser.purs
Normal file
42
test/Test/ModuleParser.purs
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user