git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
added: TypeQuery
4e5570dklntsky
spago.dhall+8−6
compare with master
unifiedsplit
@@ -1,14 +1,18 @@
1{ name =
1{ name =
2 "my-project"
2 "my-project"
3, dependencies =
3, dependencies =
4− [ "effect"
5− , "aff-promise"
4+ [ "aff-promise"
6 , "argonaut-codecs"
5 , "argonaut-codecs"
7 , "argonaut-core"
6 , "argonaut-core"
8 , "arrays"
7 , "arrays"
9 , "console"
8 , "console"
9+ , "control"
10+ , "coroutines"
11+ , "effect"
10 , "foldable-traversable"
12 , "foldable-traversable"
11 , "generics-rep"
13 , "generics-rep"
14+ , "halogen"
15+ , "halogen-css"
12 , "lists"
16 , "lists"
13 , "maybe"
17 , "maybe"
14 , "newtype"
18 , "newtype"
@@ -19,12 +23,10 @@
19 , "psci-support"
23 , "psci-support"
20 , "search-trie"
24 , "search-trie"
21 , "strings"
25 , "strings"
26+ , "string-parsers"
27+ , "test-unit"
22 , "web-dom"
28 , "web-dom"
23 , "web-html"
29 , "web-html"
24− , "halogen"
25− , "halogen-css"
26− , "coroutines"
27− , "test-unit"
28 ]
30 ]
29, packages =
31, packages =
30 ./packages.dhall
32 ./packages.dhall
src/Spago/Search/TypeQuery.pursnew file+119
@@ -0,0 +1,119 @@
1+module Spago.Search.TypeQuery where
2+
3+import Prelude
4+
5+import Control.Alt ((<|>))
6+import Data.Array as Array
7+import Data.Either (Either)
8+import Data.Foldable (foldl)
9+import Data.Generic.Rep (class Generic)
10+import Data.Generic.Rep.Show (genericShow)
11+import Data.List (List, some, (:))
12+import Data.List as List
13+import Data.List.NonEmpty (NonEmptyList, cons', uncons)
14+import Data.Maybe (Maybe(..))
15+import Data.String.CodeUnits (fromCharArray)
16+import Data.Tuple (Tuple(..))
17+import Text.Parsing.StringParser (ParseError, Parser, runParser, try)
18+import Text.Parsing.StringParser.CodePoints (alphaNum, anyLetter, char, eof, lowerCaseChar, skipSpaces, string, upperCaseChar)
19+import Text.Parsing.StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepEndBy1)
20+
21+data TypeQuery
22+ = QAny String
23+ | QConcrete String
24+ | QFun TypeQuery TypeQuery
25+ | QApp TypeQuery TypeQuery
26+ | QForAll (NonEmptyList String) TypeQuery
27+ | QConstraint String (List String) TypeQuery
28+ | QRow (List (Tuple String TypeQuery))
29+ | QEmpty
30+
31+derive instance eqTypeQuery :: Eq TypeQuery
32+derive instance genericTypeQuery :: Generic TypeQuery _
33+
34+instance showTypeQuery :: Show TypeQuery where
35+ show x = genericShow x
36+
37+parseTypeQuery :: String -> Either ParseError TypeQuery
38+parseTypeQuery = runParser (typeQueryParser <* eof)
39+
40+typeQueryParser :: Parser TypeQuery
41+typeQueryParser = fix \typeQuery ->
42+ let rowFields =
43+ QRow <$> sepBy (Tuple <$> (skipSpaces *> ident <* skipSpaces <* string "::") <*>
44+ (skipSpaces *> typeQuery <* skipSpaces))
45+ (string "," *> skipSpaces)
46+
47+ row = string "{" *> rowFields <* string "}"
48+
49+ binders =
50+ string "forall" *> some space *> sepEndBy1 ident (some space) <* string "." <* skipSpaces
51+
52+ for_all = QForAll <$> binders <*> typeQuery
53+
54+ parens =
55+ string "(" *> skipSpaces *> typeQuery <* skipSpaces <* string ")"
56+
57+ atom = skipSpaces *> (
58+ for_all <|>
59+ parens <|>
60+ row <|>
61+ concrete <|>
62+ any
63+ )
64+
65+ apps =
66+ foldl1 QApp <$> sepEndBy1 atom (some space)
67+
68+ funs =
69+ foldr1 QFun <$> sepBy1 apps (string "->" *> skipSpaces)
70+
71+ constrained =
72+ QConstraint <$> (upperCaseIdent <* some space) <*>
73+ (sepEndBy ident (some space) <* string "=>") <*>
74+ funs
75+ in
76+ try constrained <|> funs
77+
78+foldl1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a
79+foldl1 f as =
80+ case uncons as of
81+ { head, tail } -> foldl f head tail
82+
83+foldr1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a
84+foldr1 f = go List.Nil
85+ where
86+ go acc x = case uncons x of
87+ { head, tail } -> case List.uncons tail of
88+ Nothing -> List.foldl (flip f) head acc
89+ Just { head: head1, tail: tail1 } ->
90+ go (head : acc) (cons' head1 tail1)
91+
92+any :: Parser TypeQuery
93+any = do
94+ QAny <$> lowerCaseIdent
95+
96+concrete :: Parser TypeQuery
97+concrete =
98+ QConcrete <$> upperCaseIdent
99+
100+ident :: Parser String
101+ident = do
102+ head <- anyLetter
103+ rest <- Array.many alphaNum
104+ pure $ fromCharArray $ pure head <> rest
105+
106+upperCaseIdent :: Parser String
107+upperCaseIdent = do
108+ head <- upperCaseChar
109+ rest <- Array.many alphaNum
110+ pure $ fromCharArray $ pure head <> rest
111+
112+lowerCaseIdent :: Parser String
113+lowerCaseIdent = do
114+ head <- lowerCaseChar
115+ rest <- Array.many alphaNum
116+ pure $ fromCharArray $ pure head <> rest
117+
118+space :: Parser Char
119+space = char ' '
test/Main.purs+3
@@ -15,9 +15,12 @@ import Spago.Search.TypeDecoder
15import Test.Unit (suite, test, timeout)
15import Test.Unit (suite, test, timeout)
16import Test.Unit.Assert as Assert
16import Test.Unit.Assert as Assert
17import Test.Unit.Main (runTest)
17import Test.Unit.Main (runTest)
18+import Test.TypeQuery as TypeQuery
18
19
19main :: Effect Unit
20main :: Effect Unit
20main = runTest do
21main = runTest do
22+ TypeQuery.tests
23+
21 let mkJson x = unsafePartial $ fromRight $ jsonParser x
24 let mkJson x = unsafePartial $ fromRight $ jsonParser x
22 suite "FunDeps decoder" do
25 suite "FunDeps decoder" do
23 test "FunDeps" do
26 test "FunDeps" do
test/Test/TypeQuery.pursnew file+155
@@ -0,0 +1,155 @@
1+module Test.TypeQuery where
2+
3+
4+import Data.Argonaut.Decode
5+import Data.Argonaut.Encode
6+import Data.Argonaut.Parser
7+import Data.Either
8+import Data.Maybe
9+import Effect (Effect)
10+import Effect.Aff
11+import Effect.Console (log)
12+import Partial.Unsafe
13+import Prelude
14+import Spago.Search.DocsJson
15+import Spago.Search.TypeDecoder
16+import Spago.Search.TypeQuery
17+import Test.Unit (suite, test, timeout)
18+import Test.Unit.Assert as Assert
19+import Test.Unit.Main (runTest)
20+import Data.List as List
21+import Data.List (List(..), (:))
22+import Data.Tuple
23+import Data.Foldable
24+import Data.List.NonEmpty (NonEmptyList)
25+import Data.List.NonEmpty as NonEmptyList
26+
27+tests =
28+ suite "TypeQuery parser" do
29+
30+ test "test #0" do
31+ let input = "a"
32+ assertRight (parseTypeQuery input) (QAny "a")
33+
34+ test "test #0.1" do
35+ let input = "ab"
36+ assertRight (parseTypeQuery input) (QAny "ab")
37+
38+ test "test #1.0" do
39+ let input = "a b"
40+ assertRight (parseTypeQuery input) (QApp (QAny "a") (QAny "b"))
41+
42+ test "test #1.1" do
43+ let input = "a b c"
44+ assertRight (parseTypeQuery input) (QApp (QApp (QAny "a") (QAny "b")) (QAny "c"))
45+
46+ test "test #2" do
47+ let input = "a -> b"
48+ assertRight (parseTypeQuery input) (QFun (QAny "a") (QAny "b"))
49+
50+ test "test #3" do
51+ let input = "a -> b c"
52+ assertRight (parseTypeQuery input) (QFun (QAny "a") (QApp (QAny "b") (QAny "c")))
53+
54+ test "test #4" do
55+ let input = "a b -> c"
56+ assertRight (parseTypeQuery input) (QFun (QApp (QAny "a") (QAny "b")) (QAny "c"))
57+
58+ test "test #5" do
59+ let input = "a b"
60+ assertRight (parseTypeQuery input) (QApp (QAny "a") (QAny "b"))
61+
62+ test "test #6" do
63+ let input = "a (b c)"
64+ assertRight (parseTypeQuery input) (QApp (QAny "a") (QApp (QAny "b") (QAny "c")))
65+
66+ test "test #6.1" do
67+ let input = "(a b) (c d)"
68+ assertRight (parseTypeQuery input)
69+ (QApp (QApp (QAny "a") (QAny "b"))
70+ (QApp (QAny "c") (QAny "d")))
71+
72+ test "test #7" do
73+ let input = "a ( b c )"
74+ assertRight (parseTypeQuery input) (QApp (QAny "a") (QApp (QAny "b") (QAny "c")))
75+
76+ test "test #8" do
77+ let input = "aaa"
78+ assertRight (parseTypeQuery input) (QAny "aaa")
79+
80+ test "test #9" do
81+ let input = "aaa ( bbb ccc )"
82+ assertRight (parseTypeQuery input) (QApp (QAny "aaa") (QApp (QAny "bbb") (QAny "ccc")))
83+
84+ test "test #10" do
85+ let input = "(a -> b) -> (c -> d)"
86+ assertRight (parseTypeQuery input) (QFun (QFun (QAny "a") (QAny "b"))
87+ (QFun (QAny "c") (QAny "d")))
88+
89+ test "test #11" do
90+ let input = "a -> b -> c -> d"
91+ assertRight (parseTypeQuery input) (QFun (QAny "a")
92+ (QFun (QAny "b")
93+ (QFun (QAny "c") (QAny "d"))))
94+
95+ test "test #11.1" do
96+ let input = "a -> b -> c"
97+ assertRight (parseTypeQuery input) (QFun (QAny "a")
98+ (QFun (QAny "b")
99+ (QAny "c")))
100+
101+ test "test #12" do
102+ let input = "forall a b c. c"
103+ assertRight (parseTypeQuery input) (QForAll (nl "a" ["b", "c"]) (QAny "c"))
104+
105+ test "test #13" do
106+ let input = "forall a. Maybe a"
107+ assertRight (parseTypeQuery input) (QForAll (nl "a" $ []) (QApp (QConcrete "Maybe") (QAny "a")))
108+
109+ test "test #14" do
110+ let input = "forall m a. Monad m => a -> m a"
111+ assertRight (parseTypeQuery input)
112+ (QForAll (nl "m" ["a"])
113+ (QConstraint "Monad" (l ["m"])
114+ (QFun (QAny "a")
115+ (QApp (QAny "m") (QAny "a")))))
116+
117+ test "test #15" do
118+ let input = "{ a :: Int }"
119+ assertRight (parseTypeQuery input)
120+ (QRow (pure (Tuple "a" (QConcrete "Int"))))
121+
122+ test "test #16" do
123+ let input = "{a::Int}"
124+ assertRight (parseTypeQuery input)
125+ (QRow (pure (Tuple "a" (QConcrete "Int"))))
126+
127+ test "test #17" do
128+ let input = "Int"
129+ assertRight (parseTypeQuery input) (QConcrete "Int")
130+
131+ test "test #18" do
132+ let input = "a->b"
133+ assertRight (parseTypeQuery input) (QFun (QAny "a") (QAny "b"))
134+
135+l :: forall f. Foldable f => (forall a. f a -> List a)
136+l = List.fromFoldable
137+
138+nl :: forall t5 t6. Foldable t6 => t5 -> t6 t5 -> NonEmptyList t5
139+nl x rst = NonEmptyList.cons' x $ List.fromFoldable rst
140+
141+assertRight
142+ :: forall a b
143+ . Show a
144+ => Show b
145+ => Eq a
146+ => Eq b
147+ => Either b a
148+ -> a
149+ -> Aff Unit
150+assertRight eiActual expected =
151+ case eiActual of
152+ Left string -> do
153+ Assert.equal (Right expected) eiActual
154+ Right actual -> do
155+ Assert.equal (Right expected) eiActual