rowtype-yoga/purescript-docs-search
1
0
Fork 0
mirror of https://github.com/rowtype-yoga/purescript-docs-search.git synced 2024-09-11 12:35:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

fixed ForAll

Browse Source
This commit is contained in:
klntsky 2019-06-26 11:27:55 +03:00
parent a81a4d9630
commit 849bcc0ec1
No known key found for this signature in database
GPG Key ID: 612281040BC67F9E
2 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Spago/Search/TypeParser.purs
View File

@ -138,7 +138,7 @@ data Type
-- | A type application
| TypeApp Type Type
-- | Forall quantifier
| ForAll String (Maybe Kind) Type (Maybe SkolemScope)
| ForAll String Type (Maybe Kind)
-- | A type withset of type class constraints
| ConstrainedType Constraint Type
{-
@ -160,8 +160,6 @@ data Type
-- data constructor will be removed.
| ParensInType Type
type SkolemScope = Unit
derive instance eqType :: Eq Type
derive instance genericType :: Generic Type _
@ -179,8 +177,8 @@ instance showType :: Show Type where
"(TypeOp " <> show _QualifiedName <> ")"
TypeApp _Type1 _Type2 ->
"(TypeApp " <> show _Type1 <> " " <> show _Type2 <> ")"
ForAll _String _Maybe_Kind _Type _Maybe_SkolemScope ->
"(ForAll " <> show _String <> " " <> show _Maybe_Kind <> " " <> show _Type <> " " <> show _Maybe_SkolemScope <> ")"
ForAll _String _Type _Maybe_Kind ->
"(ForAll " <> show _String <> " " <> show _Type <> " " <> show _Maybe_Kind <> ")"
ConstrainedType _Constraint _Type ->
"(ConstrainedType " <> show _Constraint <> " " <> show _Type <> ")"
REmpty ->
@ -205,7 +203,7 @@ instance decodeJsonType :: DecodeJson Type where
decodeContents (decodeTuple TypeApp (const err)) (Left err) json
where err = mkJsonError' "TypeApp" json
"ForAll" ->
decodeContents (decodeTuple (\str ty -> ForAll str Nothing ty Nothing) err) (Left $ err unit) json
decodeContents (decodeTriple ForAll err) (Left $ err unit) json
where err = mkJsonError "ForAll" json
"ConstrainedType" ->
decodeContents (decodeTuple ConstrainedType err) (Left $ err unit) json
@ -231,7 +229,7 @@ instance encodeJsonType :: EncodeJson Type where
TypeConstructor val -> encodeTaggedContents "TypeConstructor" (encodeJson val)
TypeOp val -> encodeTaggedContents "TypeOp" (encodeJson val)
TypeApp t1 t2 -> encodeTaggedContents "TypeApp" (encodeTuple t1 t2)
ForAll str _ ty _ -> encodeTaggedContents "ForAll" (encodeTuple str ty) -- TODO
ForAll str ty mbk -> encodeTaggedContents "ForAll" (encodeTriple str ty mbk)
ConstrainedType c t -> encodeTaggedContents "ConstrainedType" (encodeTuple c t)
REmpty -> encodeTaggedContents "REmpty" jsonEmptyObject
RCons s t1 t2 -> encodeTaggedContents "RCons" (encodeTriple s t1 t2)

8
test/Main.purs
View File

@ -364,9 +364,9 @@ main = runTest do
{"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]}
"""
assertRight (decodeJson forallJson) $
ForAll "a" Nothing (TypeApp (TypeApp (TypeConstructor $ qualified ["Prim"] "Function")
(TypeConstructor $ qualified ["Prim"] "String"))
(TypeVar "a")) Nothing
ForAll "a" (TypeApp (TypeApp (TypeConstructor $ qualified ["Prim"] "Function")
(TypeConstructor $ qualified ["Prim"] "String"))
(TypeVar "a")) Nothing
suite "jsons" do
test "jsons #1" do
@ -374,7 +374,7 @@ main = runTest do
{"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]}
"""
assertRight (decodeJson json) $ (ForAll "o" Nothing (ForAll "r" Nothing (ForAll "l" Nothing (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "o"))))) Nothing) Nothing) Nothing)
assertRight (decodeJson json) $ (ForAll "o" (ForAll "r" (ForAll "l" (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "o"))))) Nothing) Nothing) Nothing)
suite "Kind encoder" do
test "FunKind" do