@@ -2,23 +2,21 @@ module Test.Main where
22
33import Prelude
44
5−import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
6−import Docs.Search.Types (Identifier(..))
7−import Test.TypeQuery as TypeQuery
8−import Test.IndexBuilder as IndexBuilder
9−import Test.Declarations as Declarations
10−import Test.ModuleIndex as ModuleIndex
11−import Test.UI as UI
12−
13−import Test.Extra (assertRight)
14−
5+import Data.Argonaut.Core (Json)
156import Data.Argonaut.Decode (decodeJson)
16−import Data.Argonaut.Encode (encodeJson)
177import Data.Argonaut.Parser (jsonParser)
18−import Data.Either (fromRight)
8+import Data.Either (Either(..))
199import Data.Maybe (Maybe(..))
10+import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), QualifiedName(..), Type(..))
11+import Docs.Search.Types (Identifier(..))
2012import Effect (Effect)
2113import Partial.Unsafe (unsafePartial)
14+import Test.Declarations as Declarations
15+import Test.Extra (assertRight)
16+import Test.IndexBuilder as IndexBuilder
17+import Test.ModuleIndex as ModuleIndex
18+import Test.TypeQuery as TypeQuery
19+import Test.UI as UI
2220import Test.Unit (TestSuite, suite, test)
2321import Test.Unit.Main (runTest)
2422
@@ -27,131 +25,39 @@ main = do
2725 runTest mainTest
2826 UI.main
2927
28+mkJson :: String -> Json
29+mkJson str =
30+ unsafePartial $ case jsonParser str of
31+ Right r -> r
32+
3033mainTest :: TestSuite
3134mainTest = do
3235 TypeQuery.tests
3336 IndexBuilder.tests
3437 Declarations.tests
3538 ModuleIndex.tests
36−
37− let mkJson x = unsafePartial $ fromRight $ jsonParser x
3839 suite "FunDeps decoder" do
3940 test "FunDeps" do
40− let funDeps = mkJson """
41− [
41+ let
42+ funDeps = mkJson """
4243 [
43− [
44− "lhs",
45− "rhs"
46− ],
47− [
48− "output"
49− ]
50− ]
51− ]
52− """
44+ [
45+ [
46+ "lhs",
47+ "rhs"
48+ ],
49+ [
50+ "output"
51+ ]
52+ ]
53+ ]
54+ """
5355 assertRight (decodeJson funDeps)
5456 (FunDeps [ FunDep { lhs: [ "lhs", "rhs" ]
5557 , rhs: [ "output"]
5658 }
5759 ])
5860
59− suite "Kind decoder" do
60−
61− test "QualifiedName" do
62−
63− let qualifiedName = mkJson """
64− [
65− [
66− "Prim"
67− ],
68− "Type"
69− ]
70− """
71−
72− assertRight (decodeJson qualifiedName)
73− (qualified ["Prim"] "Type")
74−
75− test "NamedKind" do
76− let namedKind = mkJson """
77− {
78− "annotation": [],
79− "tag": "NamedKind",
80− "contents": [
81− [
82− "Prim"
83− ],
84− "Type"
85− ]
86− }
87− """
88−
89− assertRight (decodeJson namedKind)
90− (NamedKind $ qualified ["Prim"] "Type")
91−
92− test "Row" do
93− let row = mkJson """
94− {
95− "annotation": [],
96− "tag": "Row",
97− "contents": {
98− "annotation": [],
99− "tag": "NamedKind",
100− "contents": [
101− [
102− "Prim"
103− ],
104− "Type"
105− ]
106− }
107− }
108− """
109−
110− assertRight (decodeJson row) (Row $ NamedKind $ qualified ["Prim"] "Type")
111−
112− test "FunKind" do
113− let funKind = mkJson """
114− {
115− "annotation": [],
116− "tag": "FunKind",
117− "contents": [
118− {
119− "annotation": [],
120− "tag": "Row",
121− "contents": {
122− "annotation": [],
123− "tag": "NamedKind",
124− "contents": [
125− [
126− "Prim"
127− ],
128− "Type"
129− ]
130− }
131− },
132− {
133− "annotation": [],
134− "tag": "Row",
135− "contents": {
136− "annotation": [],
137− "tag": "NamedKind",
138− "contents": [
139− [
140− "Prim"
141− ],
142− "Type"
143− ]
144− }
145− }
146− ]
147− }
148− """
149− assertRight (decodeJson funKind)
150− (FunKind (Row $ NamedKind $ qualified ["Prim"] "Type")
151− (Row $ NamedKind $ qualified ["Prim"] "Type")
152− )
153−
154−
15561 suite "Constraint decoder" do
15662 test "Constraint" do
15763 let constraint = mkJson """
@@ -372,155 +278,6 @@ mainTest = do
372278 (TypeConstructor $ qualified ["Prim"] "String"))
373279 (TypeVar "a"))
374280
375− test "ForAll #2" do
376− let forallJson = mkJson """
377−{
378− "annotation": [],
379− "tag": "ForAll",
380− "contents": [
381− "f",
382− {
383− "annotation": [],
384− "tag": "FunKind",
385− "contents": [
386− {
387− "annotation": [],
388− "tag": "NamedKind",
389− "contents": [
390− [
391− "Prim",
392− "RowList"
393− ],
394− "RowList"
395− ]
396− },
397− {
398− "annotation": [],
399− "tag": "NamedKind",
400− "contents": [
401− [
402− "Prim"
403− ],
404− "Type"
405− ]
406− }
407− ]
408− },
409− {
410− "annotation": [],
411− "tag": "TypeApp",
412− "contents": [
413− {
414− "annotation": [],
415− "tag": "TypeApp",
416− "contents": [
417− {
418− "annotation": [],
419− "tag": "TypeConstructor",
420− "contents": [
421− [
422− "Prim"
423− ],
424− "Function"
425− ]
426− },
427− {
428− "annotation": [],
429− "tag": "TypeApp",
430− "contents": [
431− {
432− "annotation": [],
433− "tag": "TypeVar",
434− "contents": "f"
435− },
436− {
437− "annotation": [],
438− "tag": "TypeVar",
439− "contents": "l"
440− }
441− ]
442− }
443− ]
444− },
445− {
446− "annotation": [],
447− "tag": "TypeApp",
448− "contents": [
449− {
450− "annotation": [],
451− "tag": "TypeConstructor",
452− "contents": [
453− [
454− "Data",
455− "List",
456− "Types"
457− ],
458− "List"
459− ]
460− },
461− {
462− "annotation": [],
463− "tag": "ParensInType",
464− "contents": {
465− "annotation": [],
466− "tag": "TypeApp",
467− "contents": [
468− {
469− "annotation": [],
470− "tag": "TypeApp",
471− "contents": [
472− {
473− "annotation": [],
474− "tag": "TypeConstructor",
475− "contents": [
476− [
477− "Data",
478− "Tuple"
479− ],
480− "Tuple"
481− ]
482− },
483− {
484− "annotation": [],
485− "tag": "TypeConstructor",
486− "contents": [
487− [
488− "Prim"
489− ],
490− "String"
491− ]
492− }
493− ]
494− },
495− {
496− "annotation": [],
497− "tag": "TypeConstructor",
498− "contents": [
499− [
500− "Prim"
501− ],
502− "String"
503− ]
504− }
505− ]
506− }
507− }
508− ]
509− }
510− ]
511− },
512− null
513− ]
514−}
515− """
516− assertRight (decodeJson forallJson) $
517− ForAll "f"
518− (Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: Identifier "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Type" }))))
519− (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeVar "f") (TypeVar "l"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","List","Types"], name: Identifier "List" })) (ParensInType (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","Tuple"], name: Identifier "Tuple" })) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "String" }))) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "String" }))))))
520−
521−
522−
523−
524281 suite "jsons" do
525282
526283 test "jsons #1" do
@@ -530,14 +287,6 @@ mainTest = do
530287
531288 assertRight (decodeJson json) $ (ForAll "o" Nothing (ForAll "r" Nothing (ForAll "l" Nothing (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "o"))))))))
532289
533− suite "Kind encoder" do
534− test "FunKind" do
535− let k1 =
536− FunKind (Row (NamedKind $ qualified [] "a"))
537− (FunKind (NamedKind $ qualified [] "b")
538− (NamedKind $ qualified [] "b"))
539− assertRight (decodeJson $ encodeJson $ k1) k1
540−
541290
542291qualified :: Array String -> String -> QualifiedName
543292qualified moduleNameParts name = QualifiedName { moduleNameParts, name: Identifier name }