mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-09-11 12:35:37 +03:00
finished type encoding & decoding
This commit is contained in:
klntsky
parent
5d24954f8f
commit
a81a4d9630
@ -2,6 +2,8 @@ module Spago.Search.Declarations where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Spago.Search.TypeParser (Kind, Type)
|
||||
|
||||
import Control.Promise (Promise, toAffE)
|
||||
import Data.Argonaut.Core (Json, fromString, stringify, toString)
|
||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
|
||||
@ -87,6 +89,8 @@ newtype IndexEntry
|
||||
= IndexEntry { title :: String
|
||||
, comments :: Maybe String
|
||||
, info :: { declType :: DeclType
|
||||
, kind :: Maybe Kind
|
||||
, type :: Maybe Type
|
||||
}
|
||||
, sourceSpan :: { start :: Array Int
|
||||
, end :: Array Int
|
||||
@ -108,7 +112,11 @@ instance decodeJsonIndexEntry :: DecodeJson IndexEntry where
|
||||
title <- handle .: "title"
|
||||
comments <- handle .:? "comments"
|
||||
children <- handle .: "children"
|
||||
info <- handle .: "info"
|
||||
info <- handle .: "info" >>= \ihandle -> do
|
||||
ty <- ihandle .:? "type"
|
||||
kind <- ihandle .:? "kind"
|
||||
declType <- ihandle .: "declType"
|
||||
pure { type: ty, kind, declType }
|
||||
sourceSpan <- handle .: "sourceSpan"
|
||||
pure { title, comments, info, sourceSpan, children }
|
||||
|
||||
|
||||
@ -1,17 +1,17 @@
|
||||
module Spago.Search.TypeParser where
|
||||
|
||||
import Control.Alt
|
||||
import Data.Argonaut.Core
|
||||
import Data.Either
|
||||
import Data.Maybe
|
||||
import Data.Newtype
|
||||
import Data.Traversable
|
||||
import Prelude
|
||||
|
||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
|
||||
import Data.Array as Array
|
||||
import Data.Argonaut.Core (Json, caseJsonObject, fromArray, fromObject, jsonEmptyObject, stringify, toArray)
|
||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
|
||||
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
|
||||
import Data.Array ((!!))
|
||||
import Data.Either (Either(..))
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Generic.Rep.Show (genericShow)
|
||||
import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Newtype (class Newtype)
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Foreign.Object as Object
|
||||
|
||||
derive instance eqQualifiedName :: Eq QualifiedName
|
||||
@ -32,6 +32,10 @@ instance decodeJsonQualifiedName :: DecodeJson QualifiedName where
|
||||
(mkJsonError "QualifiedName" json)
|
||||
json
|
||||
|
||||
instance encodeJsonQualifiedName :: EncodeJson QualifiedName where
|
||||
encodeJson (QualifiedName { moduleName, name }) =
|
||||
encodeTuple moduleName name
|
||||
|
||||
mkJsonError :: String -> Json -> (forall i. i -> String)
|
||||
mkJsonError name json _ =
|
||||
"Couldn't parse " <> name <> " from " <> stringify json
|
||||
@ -57,23 +61,6 @@ instance showKind :: Show Kind where
|
||||
FunKind k1 k2 -> "(FunKind " <> show k1 <> " " <> show k2 <> ")"
|
||||
NamedKind name -> "(NamedKind " <> show name <> ")"
|
||||
|
||||
newtype MaybeSingle a = MaybeSingle (Either a (Array a))
|
||||
|
||||
derive instance eqMaybeSingle :: Eq a => Eq (MaybeSingle a)
|
||||
derive instance genericMaybeSingle :: Generic (MaybeSingle a) _
|
||||
derive instance newtypeMaybeSingle :: Newtype (MaybeSingle a) _
|
||||
|
||||
instance showMaybeSingle :: Show a => Show (MaybeSingle a) where
|
||||
show = genericShow
|
||||
|
||||
instance decodeJsonMaybeSingle :: DecodeJson a => DecodeJson (MaybeSingle a) where
|
||||
decodeJson json =
|
||||
MaybeSingle <$> (Left <$> decodeJson json <|> Right <$> decodeJson json)
|
||||
|
||||
fromMaybeSingle :: forall a. MaybeSingle a -> Array a
|
||||
fromMaybeSingle (MaybeSingle (Left a)) = Array.singleton a
|
||||
fromMaybeSingle (MaybeSingle (Right a)) = a
|
||||
|
||||
instance decodeJsonKind :: DecodeJson Kind where
|
||||
decodeJson json = do
|
||||
handle <- decodeJson json
|
||||
@ -93,11 +80,20 @@ instance decodeJsonKind :: DecodeJson Kind where
|
||||
_ -> Left $ mkJsonError' "FunKind" json
|
||||
_ -> Left $ mkJsonError' "Kind" json
|
||||
|
||||
instance encodeJsonKind :: EncodeJson Kind where
|
||||
encodeJson = case _ of
|
||||
Row k ->
|
||||
encodeTaggedContents "Row" (encodeJson k)
|
||||
FunKind k1 k2 ->
|
||||
encodeTaggedContents "FunKind" (encodeTuple k1 k2)
|
||||
NamedKind qname ->
|
||||
encodeTaggedContents "NamedKind" (encodeJson qname)
|
||||
|
||||
-- | A typeclass constraint
|
||||
newtype Constraint = Constraint
|
||||
{ constraintClass :: QualifiedName
|
||||
-- ^ constraint class name
|
||||
, constraintArgs :: Array Unit
|
||||
, constraintArgs :: Array Type
|
||||
-- ^ type arguments
|
||||
}
|
||||
|
||||
@ -111,7 +107,14 @@ instance showConstraint :: Show Constraint where
|
||||
instance decodeJsonConstraint :: DecodeJson Constraint where
|
||||
decodeJson json = Constraint <$> decodeJson json
|
||||
|
||||
type ConstraintData = Unit
|
||||
instance encodeJsonConstraint :: EncodeJson Constraint where
|
||||
encodeJson (Constraint { constraintClass
|
||||
, constraintArgs
|
||||
})
|
||||
= fromObject $ Object.fromFoldable
|
||||
[ Tuple "constraintClass" (encodeJson constraintClass)
|
||||
, Tuple "constraintArgs" (encodeJson constraintArgs)
|
||||
]
|
||||
|
||||
-- |
|
||||
-- The type of types
|
||||
@ -126,7 +129,7 @@ data Type
|
||||
-- | A type-level string
|
||||
| TypeLevelString String
|
||||
-- | A type wildcard, as would appear in a partial type synonym
|
||||
| TypeWildcard (Maybe String)
|
||||
| TypeWildcard
|
||||
-- | A type constructor
|
||||
| TypeConstructor QualifiedName
|
||||
-- | A type operator. This will be desugared into a type constructor during the
|
||||
@ -135,7 +138,7 @@ data Type
|
||||
-- | A type application
|
||||
| TypeApp Type Type
|
||||
-- | Forall quantifier
|
||||
| ForAll String {- (Maybe Kind) -} Type {- (Maybe SkolemScope) -}
|
||||
| ForAll String (Maybe Kind) Type (Maybe SkolemScope)
|
||||
-- | A type withset of type class constraints
|
||||
| ConstrainedType Constraint Type
|
||||
{-
|
||||
@ -152,11 +155,13 @@ data Type
|
||||
-}
|
||||
-- | Binary operator application. During the rebracketing phase of desugaring,
|
||||
-- this data constructor will be removed.
|
||||
| BinaryNoParens Type Type Type
|
||||
| BinaryNoParensType Type Type Type
|
||||
-- | Explicit parentheses. During the rebracketing phase of desugaring, this
|
||||
-- data constructor will be removed.
|
||||
| ParensInType Type
|
||||
|
||||
type SkolemScope = Unit
|
||||
|
||||
derive instance eqType :: Eq Type
|
||||
derive instance genericType :: Generic Type _
|
||||
|
||||
@ -166,31 +171,23 @@ instance showType :: Show Type where
|
||||
"(TypeVar " <> show _String <> ")"
|
||||
TypeLevelString _String ->
|
||||
"(TypeLevelString " <> show _String <> ")"
|
||||
TypeWildcard _Maybe_String ->
|
||||
"(TypeWildcard " <> show _Maybe_String <> ")"
|
||||
TypeWildcard ->
|
||||
"TypeWildcard"
|
||||
TypeConstructor _QualifiedName ->
|
||||
"(TypeConstructor " <> show _QualifiedName <> ")"
|
||||
TypeOp _QualifiedName ->
|
||||
"(TypeOp " <> show _QualifiedName <> ")"
|
||||
TypeApp _Type1 _Type2 ->
|
||||
"(TypeApp " <> show _Type1 <> " " <> show _Type2 <> ")"
|
||||
ForAll _String _Type ->
|
||||
"(ForAll " <> show _String <> " " <> show _Type <> ")"
|
||||
ForAll _String _Maybe_Kind _Type _Maybe_SkolemScope ->
|
||||
"(ForAll " <> show _String <> " " <> show _Maybe_Kind <> " " <> show _Type <> " " <> show _Maybe_SkolemScope <> ")"
|
||||
ConstrainedType _Constraint _Type ->
|
||||
"(ConstrainedType " <> show _Constraint <> " " <> show _Type <> ")"
|
||||
{-
|
||||
SkolemText _Int _SkolemScope ->
|
||||
"(SkolemText " <> show _Int <> " " <> show _SkolemScope <> ")"
|
||||
-}
|
||||
REmpty ->
|
||||
"REmpty"
|
||||
RCons _String _Type1 _Type2 ->
|
||||
"(RConsLabel " <> show _String <> " " <> show _Type1 <> " " <> show _Type2 <> ")"
|
||||
{-
|
||||
Kinded _Type _Kind ->
|
||||
"(KindedTypeType " <> show _Type <> " " <> show _Kind <> ")"
|
||||
-}
|
||||
BinaryNoParens _Type1 _Type2 _Type3 ->
|
||||
BinaryNoParensType _Type1 _Type2 _Type3 ->
|
||||
"(BinaryNoParensTypeType " <> show _Type1 <> " " <> show _Type2 <> " " <> show _Type3 <> ")"
|
||||
ParensInType _Type ->
|
||||
"(ParensInType " <> show _Type <> ")"
|
||||
@ -200,62 +197,48 @@ instance decodeJsonType :: DecodeJson Type where
|
||||
handle <- decodeJson json
|
||||
tag <- handle .: "tag"
|
||||
case tag of
|
||||
"TypeVar" -> do
|
||||
contents <- handle .: "contents"
|
||||
pure $ TypeVar contents
|
||||
"TypeLevelString" -> do
|
||||
contents <- handle .: "contents"
|
||||
pure $ TypeLevelString contents
|
||||
"TypeWildCard" -> do
|
||||
contents <- handle .:? "contents"
|
||||
pure $ TypeWildcard contents
|
||||
"TypeConstructor" -> do
|
||||
contents <- handle .: "contents"
|
||||
pure $ TypeConstructor contents
|
||||
"TypeOp" -> do
|
||||
contents <- handle .: "contents"
|
||||
pure $ TypeOp contents
|
||||
"TypeApp" -> do
|
||||
contents <- handle .: "contents"
|
||||
case contents of
|
||||
[t1, t2] -> do
|
||||
pure $ TypeApp t1 t2
|
||||
_ ->
|
||||
Left $ mkJsonError' "TypeApp" json
|
||||
"TypeVar" -> handle .: "contents" >>= TypeVar >>> pure
|
||||
"TypeLevelString" -> handle .: "contents" >>= TypeLevelString >>> pure
|
||||
"TypeConstructor" -> handle .: "contents" >>= TypeConstructor >>> pure
|
||||
"TypeOp" -> handle .: "contents" >>= TypeOp >>> pure
|
||||
"TypeApp" ->
|
||||
decodeContents (decodeTuple TypeApp (const err)) (Left err) json
|
||||
where err = mkJsonError' "TypeApp" json
|
||||
"ForAll" ->
|
||||
decodeContents
|
||||
(decodeTuple ForAll (mkJsonError "ForAll" json))
|
||||
(Left $ mkJsonError' "ForAll" json)
|
||||
json
|
||||
decodeContents (decodeTuple (\str ty -> ForAll str Nothing ty Nothing) err) (Left $ err unit) json
|
||||
where err = mkJsonError "ForAll" json
|
||||
"ConstrainedType" ->
|
||||
let err = mkJsonError "ForAll" json in
|
||||
decodeContents (decodeTuple ConstrainedType err) (Left $ err unit) json
|
||||
"REmpty" ->
|
||||
Right REmpty
|
||||
where err = mkJsonError "ForAll" json
|
||||
"REmpty" -> Right REmpty
|
||||
"RCons" ->
|
||||
let err = mkJsonError' "RCons" json in
|
||||
decodeContents
|
||||
(decodeTriple
|
||||
(\label ty rest ->
|
||||
RCons label ty rest)
|
||||
(const err))
|
||||
(Left $ err)
|
||||
json
|
||||
"BinaryNoParensType" -> do
|
||||
contents <- handle .: "contents"
|
||||
case contents of
|
||||
[ t1, t2, t3 ] -> do
|
||||
pure $ BinaryNoParens t1 t2 t3
|
||||
_ -> Left $ mkJsonError' "BinaryNoParens" json
|
||||
"ParensInType" ->
|
||||
decodeContents
|
||||
(map ParensInType <<< decodeJson)
|
||||
(Left $ mkJsonError' "ParensInType" json)
|
||||
json
|
||||
decodeContents (decodeTriple RCons (const err)) (Left err) json
|
||||
where err = mkJsonError' "RCons" json
|
||||
"BinaryNoParensType" ->
|
||||
decodeContents (decodeTriple BinaryNoParensType (const err)) (Left err) json
|
||||
where err = mkJsonError' "BinaryNoParens" json
|
||||
"ParensInType" -> decodeContents
|
||||
(map ParensInType <<< decodeJson)
|
||||
(Left $ mkJsonError' "ParensInType" json)
|
||||
json
|
||||
"TypeWildcard" -> Right TypeWildcard
|
||||
_ -> Left $ mkJsonError' "Type" json
|
||||
|
||||
|
||||
type SkolemScope = Unit
|
||||
instance encodeJsonType :: EncodeJson Type where
|
||||
encodeJson = case _ of
|
||||
TypeVar val -> encodeTaggedContents "TypeVar" (encodeJson val)
|
||||
TypeLevelString val -> encodeTaggedContents "TypeLevelString" (encodeJson val)
|
||||
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
|
||||
ConstrainedType c t -> encodeTaggedContents "ConstrainedType" (encodeTuple c t)
|
||||
REmpty -> encodeTaggedContents "REmpty" jsonEmptyObject
|
||||
RCons s t1 t2 -> encodeTaggedContents "RCons" (encodeTriple s t1 t2)
|
||||
BinaryNoParensType t1 t2 t3 ->
|
||||
encodeTaggedContents "BinaryNoParensType" (encodeTriple t1 t2 t3)
|
||||
ParensInType t -> encodeTaggedContents "ParensInType" (encodeJson t)
|
||||
TypeWildcard -> encodeTaggedContents "TypeWildcard" jsonEmptyObject
|
||||
|
||||
-- | Decode a heterogeneous tuple, serialized as an array.
|
||||
-- | e.g. `[0, ""]` to `Tuple 0 ""`
|
||||
@ -268,40 +251,34 @@ decodeTuple
|
||||
-> Json
|
||||
-> Either String res
|
||||
decodeTuple cont err json =
|
||||
case toArray json of
|
||||
Nothing -> Left $ err unit
|
||||
Just arrOfJsons -> do
|
||||
let arrayOfVariants =
|
||||
arrOfJsons <#> \variantJson ->
|
||||
Left <$> decodeJson variantJson <|>
|
||||
Right <$> decodeJson variantJson
|
||||
case arrayOfVariants of
|
||||
[ Right (Left a), Right (Right b) ] ->
|
||||
Right $ cont a b
|
||||
_ -> Left $ err unit
|
||||
fromMaybe (Left $ err unit) $
|
||||
toArray json >>= \jsons ->
|
||||
jsons !! 0 >>= \json1 ->
|
||||
jsons !! 1 >>= \json2 -> pure $ do
|
||||
fst <- decodeJson json1
|
||||
sec <- decodeJson json2
|
||||
pure $ cont fst sec
|
||||
|
||||
-- | Decode a heterogeneous triple.
|
||||
decodeTriple
|
||||
:: forall fst sec res
|
||||
:: forall fst sec trd res
|
||||
. DecodeJson fst
|
||||
=> DecodeJson sec
|
||||
=> (fst -> sec -> sec -> res)
|
||||
=> DecodeJson trd
|
||||
=> (fst -> sec -> trd -> res)
|
||||
-> (forall a. a -> String)
|
||||
-> Json
|
||||
-> Either String res
|
||||
decodeTriple cont err json =
|
||||
case toArray json of
|
||||
Nothing -> Left $ err unit
|
||||
Just arrOfJsons -> do
|
||||
let arrayOfVariants =
|
||||
arrOfJsons <#> \variantJson ->
|
||||
Left <$> decodeJson variantJson <|>
|
||||
Right <$> decodeJson variantJson <|>
|
||||
Right <$> decodeJson variantJson
|
||||
case arrayOfVariants of
|
||||
[ Right (Left a), Right (Right b), Right (Right c) ] ->
|
||||
Right $ cont a b c
|
||||
_ -> Left $ err unit
|
||||
Just [ json1, json2, json3 ] -> do
|
||||
fst <- decodeJson json1
|
||||
sec <- decodeJson json2
|
||||
trd <- decodeJson json3
|
||||
pure $ cont fst sec trd
|
||||
_ -> Left $ err unit
|
||||
|
||||
-- | Decode a `.contents` property.
|
||||
decodeContents :: forall r. (Json -> r) -> r -> Json -> r
|
||||
decodeContents go err json =
|
||||
caseJsonObject err
|
||||
@ -311,3 +288,32 @@ decodeContents go err json =
|
||||
Just contentsJson -> go contentsJson
|
||||
)
|
||||
json
|
||||
|
||||
encodeTuple
|
||||
:: forall fst sec
|
||||
. EncodeJson fst
|
||||
=> EncodeJson sec
|
||||
=> fst
|
||||
-> sec
|
||||
-> Json
|
||||
encodeTuple fst sec =
|
||||
fromArray [ encodeJson fst, encodeJson sec ]
|
||||
|
||||
encodeTriple
|
||||
:: forall fst sec trd
|
||||
. EncodeJson fst
|
||||
=> EncodeJson sec
|
||||
=> EncodeJson trd
|
||||
=> fst
|
||||
-> sec
|
||||
-> trd
|
||||
-> Json
|
||||
encodeTriple fst sec trd =
|
||||
fromArray [ encodeJson fst, encodeJson sec, encodeJson trd ]
|
||||
|
||||
encodeTaggedContents :: String -> Json -> Json
|
||||
encodeTaggedContents tag contents =
|
||||
fromObject $ Object.fromFoldable
|
||||
[ Tuple "tag" (encodeJson tag)
|
||||
, Tuple "contents" contents
|
||||
]
|
||||
|
||||
@ -1,23 +1,24 @@
|
||||
module Test.Main where
|
||||
|
||||
import Data.Argonaut.Decode
|
||||
import Data.Argonaut.Encode
|
||||
import Data.Argonaut.Parser
|
||||
import Data.Either
|
||||
import Data.Maybe
|
||||
import Effect (Effect)
|
||||
import Effect.Aff
|
||||
import Effect.Console (log)
|
||||
import Partial.Unsafe
|
||||
import Prelude
|
||||
import Spago.Search.Declarations
|
||||
import Spago.Search.TypeParser
|
||||
|
||||
import Effect (Effect)
|
||||
import Effect.Console (log)
|
||||
import Test.Unit (suite, test, timeout)
|
||||
import Test.Unit.Assert as Assert
|
||||
import Test.Unit.Main (runTest)
|
||||
|
||||
main :: Effect Unit
|
||||
main = runTest do
|
||||
let mkJson x = unsafePartial $ fromRight $ jsonParser x
|
||||
let mkJson x = unsafePartial $ fromRight $ jsonParser x
|
||||
suite "Kind parser" do
|
||||
|
||||
test "QualifiedName" do
|
||||
@ -257,7 +258,7 @@ main = runTest do
|
||||
"""
|
||||
|
||||
assertRight (decodeJson binaryNoParens) $
|
||||
BinaryNoParens
|
||||
BinaryNoParensType
|
||||
(TypeOp $ QualifiedName { moduleName: ["Data", "NaturalTransformation"], name: "~>" })
|
||||
(TypeVar "m")
|
||||
(TypeVar "n")
|
||||
@ -358,6 +359,34 @@ main = runTest do
|
||||
(TypeVar "t"))
|
||||
REmpty
|
||||
|
||||
test "ForAll" do
|
||||
let forallJson = mkJson """
|
||||
{"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
|
||||
suite "jsons" do
|
||||
|
||||
test "jsons #1" do
|
||||
let json = mkJson """
|
||||
{"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)
|
||||
|
||||
suite "Kind encoder" do
|
||||
test "FunKind" do
|
||||
let k1 =
|
||||
FunKind (Row (NamedKind $ qualified [] "a"))
|
||||
(FunKind (NamedKind $ qualified [] "b")
|
||||
(NamedKind $ qualified [] "b"))
|
||||
assertRight (decodeJson $ encodeJson $ k1) k1
|
||||
|
||||
|
||||
qualified moduleName name = QualifiedName { moduleName, name }
|
||||
|
||||
assertRight :: forall a. Show a => Eq a => Either String a -> a -> Aff Unit
|
||||
assertRight eiActual expected =
|
||||
case eiActual of
|
||||
|
||||
Loading…
Reference in New Issue
Block a user