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 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
|
||||
|
||||
|
@ -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
|
||||
|
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