@@ -2,22 +2,14 @@ module Test.Main where
22
33import Prelude
44
5−import Data.Argonaut.Core (Json)
6−import Data.Argonaut.Decode (decodeJson)
7−import Data.Argonaut.Parser (jsonParser)
8−import Data.Either (Either(..))
9−import Data.Maybe (Maybe(..))
10−import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), QualifiedName(..), Type(..))
11−import Docs.Search.Types (Identifier(..))
125import Effect (Effect)
13−import Partial.Unsafe (unsafePartial)
146import Test.Declarations as Declarations
15−import Test.Extra (assertRight)
167import Test.IndexBuilder as IndexBuilder
178import Test.ModuleIndex as ModuleIndex
189import Test.TypeQuery as TypeQuery
10+import Test.TypeJson as TypeJson
1911import Test.UI as UI
20−import Test.Unit (TestSuite, suite, test)
12+import Test.Unit (TestSuite)
2113import Test.Unit.Main (runTest)
2214
2315main :: Effect Unit
@@ -25,268 +17,10 @@ main = do
2517 runTest mainTest
2618 UI.main
2719
28−mkJson :: String -> Json
29−mkJson str =
30− unsafePartial $ case jsonParser str of
31− Right r -> r
32−
3320mainTest :: TestSuite
3421mainTest = do
3522 TypeQuery.tests
23+ TypeJson.tests
3624 IndexBuilder.tests
3725 Declarations.tests
3826 ModuleIndex.tests
39− suite "FunDeps decoder" do
40− test "FunDeps" do
41− let
42− funDeps = mkJson """
43− [
44− [
45− [
46− "lhs",
47− "rhs"
48− ],
49− [
50− "output"
51− ]
52− ]
53− ]
54− """
55− assertRight (decodeJson funDeps)
56− (FunDeps [ FunDep { lhs: [ "lhs", "rhs" ]
57− , rhs: [ "output"]
58− }
59− ])
60−
61− suite "Constraint decoder" do
62− test "Constraint" do
63− let constraint = mkJson """
64− {
65− "constraintAnn": [],
66− "constraintClass": [
67− [
68− "Prim"
69− ],
70− "Partial"
71− ],
72− "constraintArgs": [],
73− "constraintData": null
74− }
75− """
76− assertRight (decodeJson constraint)
77− (Constraint { constraintClass: qualified ["Prim"] "Partial"
78− , constraintArgs: []
79− })
80−
81− suite "Type decoder" do
82− test "TypeVar" do
83− let typeVar = mkJson """
84− {
85− "annotation": [],
86− "tag": "TypeVar",
87− "contents": "m"
88− }
89− """
90−
91− assertRight (decodeJson typeVar)
92− (TypeVar "m")
93−
94− test "TypeApp" do
95− let typeApp1 = mkJson """
96− {
97− "annotation": [],
98− "tag": "TypeApp",
99− "contents": [
100− {
101− "annotation": [],
102− "tag": "TypeConstructor",
103− "contents": [
104− [
105− "Control",
106− "Monad",
107− "ST",
108− "Internal"
109− ],
110− "ST"
111− ]
112− },
113− {
114− "annotation": [],
115− "tag": "TypeVar",
116− "contents": "h"
117− }
118− ]
119− }
120− """
121−
122− assertRight (decodeJson typeApp1) $
123− TypeApp
124− (TypeConstructor (qualified [ "Control"
125− , "Monad"
126− , "ST"
127− , "Internal"
128− ]
129− "ST"
130− ))
131− (TypeVar "h")
132−
133− test "TypeOp" do
134− let typeOp = mkJson """
135− {
136− "annotation": [],
137− "tag": "TypeOp",
138− "contents": [
139− [
140− "Data",
141− "NaturalTransformation"
142− ],
143− "~>"
144− ]
145− }
146− """
147− assertRight (decodeJson typeOp) $
148− TypeOp $ qualified [ "Data", "NaturalTransformation" ] "~>"
149−
150− test "BinaryNoParens" do
151− let binaryNoParens = mkJson """
152− {
153− "annotation": [],
154− "tag": "BinaryNoParensType",
155− "contents": [
156− {
157− "annotation": [],
158− "tag": "TypeOp",
159− "contents": [
160− [
161− "Data",
162− "NaturalTransformation"
163− ],
164− "~>"
165− ]
166− },
167− {
168− "annotation": [],
169− "tag": "TypeVar",
170− "contents": "m"
171− },
172− {
173− "annotation": [],
174− "tag": "TypeVar",
175− "contents": "n"
176− }
177− ]
178− }
179− """
180−
181− assertRight (decodeJson binaryNoParens) $
182− BinaryNoParensType
183− (TypeOp $ qualified ["Data", "NaturalTransformation"] "~>")
184− (TypeVar "m")
185− (TypeVar "n")
186−
187− test "ParensInType" do
188− let parensInType = mkJson """
189− {
190− "annotation": [],
191− "tag": "ParensInType",
192− "contents": {
193− "annotation": [],
194− "tag": "TypeApp",
195− "contents": [
196− {
197− "annotation": [],
198− "tag": "TypeConstructor",
199− "contents": [
200− [
201− "Data",
202− "Maybe"
203− ],
204− "Maybe"
205− ]
206− },
207− {
208− "annotation": [],
209− "tag": "TypeConstructor",
210− "contents": [
211− [
212− "Prim"
213− ],
214− "String"
215− ]
216− }
217− ]
218− }
219− }
220− """
221−
222− assertRight (decodeJson parensInType) $
223− ParensInType $
224− TypeApp
225− (TypeConstructor (qualified [ "Data", "Maybe" ] "Maybe"))
226− (TypeConstructor (qualified [ "Prim" ] "String"))
227− test "RCons" do
228−
229− let rcons = mkJson """
230− {
231− "annotation": [],
232− "tag": "RCons",
233− "contents": [
234− "tail",
235− {
236− "annotation": [],
237− "tag": "TypeApp",
238− "contents": [
239− {
240− "annotation": [],
241− "tag": "TypeConstructor",
242− "contents": [
243− [
244− "Data",
245− "Symbol"
246− ],
247− "SProxy"
248− ]
249− },
250− {
251− "annotation": [],
252− "tag": "TypeVar",
253− "contents": "t"
254− }
255− ]
256− },
257− {
258− "annotation": [],
259− "tag": "REmpty"
260− }
261− ]
262− }
263− """
264−
265− assertRight (decodeJson rcons) $
266− RCons
267− (Identifier "tail")
268− (TypeApp (TypeConstructor $ qualified [ "Data", "Symbol" ] "SProxy")
269− (TypeVar "t"))
270− REmpty
271−
272− test "ForAll #1" do
273− let forallJson = mkJson """
274− {"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}
275− """
276− assertRight (decodeJson forallJson) $
277− ForAll "a" Nothing (TypeApp (TypeApp (TypeConstructor $ qualified ["Prim"] "Function")
278− (TypeConstructor $ qualified ["Prim"] "String"))
279− (TypeVar "a"))
280−
281− suite "jsons" do
282−
283− test "jsons #1" do
284− let json = mkJson """
285−{"annotation":[],"tag":"ForAll","contents":["o",{"annotation":[],"tag":"ForAll","contents":["r",{"annotation":[],"tag":"ForAll","contents":["l",{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Type","Data","Boolean"],"And"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"l"},{"annotation":[],"tag":"TypeVar","contents":"r"},{"annotation":[],"tag":"TypeVar","contents":"o"}],"constraintData":null},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"l"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"r"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"o"}]}]}]}]},null]},null]},null]}
286− """
287−
288− 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"))))))))
289−
290−
291−qualified :: Array String -> String -> QualifiedName
292−qualified moduleNameParts name = QualifiedName { moduleNameParts, name: Identifier name }