-- | Decoding of encoded types (as terms) back to types according to LambdaGraph's epsilon encoding

module Hydra.CoreDecoding (
  coreDecodeFieldType,
  coreDecodeFieldTypes,
  coreDecodeFloatType,
  coreDecodeFunctionType,
  coreDecodeIntegerType,
  coreDecodeLambdaType,
  coreDecodeLiteralType,
  coreDecodeMapType,
  coreDecodeName,
  coreDecodeRowType,
  coreDecodeString,
  coreDecodeType,
  ) where

import Hydra.Basics
import Hydra.Strip
import Hydra.Coders
import Hydra.Compute
import Hydra.Core
import Hydra.Graph
import Hydra.Mantle
import Hydra.Module
import Hydra.Lexical
import Hydra.Rewriting
import Hydra.Tier1
import Hydra.Tier2
import qualified Hydra.Dsl.Expect as Expect
import qualified Hydra.Dsl.Terms as Terms

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


coreDecodeApplicationType :: Term -> Flow Graph (ApplicationType)
coreDecodeApplicationType :: Term -> Flow Graph ApplicationType
coreDecodeApplicationType = (Map Name Term -> Flow Graph ApplicationType)
-> Term -> Flow Graph ApplicationType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph ApplicationType)
 -> Term -> Flow Graph ApplicationType)
-> (Map Name Term -> Flow Graph ApplicationType)
-> Term
-> Flow Graph ApplicationType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Type -> Type -> ApplicationType
ApplicationType
  (Type -> Type -> ApplicationType)
-> Flow Graph Type -> Flow Graph (Type -> ApplicationType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_ApplicationType_function Term -> Flow Graph Type
coreDecodeType
  Flow Graph (Type -> ApplicationType)
-> Flow Graph Type -> Flow Graph ApplicationType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_ApplicationType_argument Term -> Flow Graph Type
coreDecodeType

coreDecodeFieldType :: Term -> Flow Graph (FieldType)
coreDecodeFieldType :: Term -> Flow Graph FieldType
coreDecodeFieldType = (Map Name Term -> Flow Graph FieldType)
-> Term -> Flow Graph FieldType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph FieldType)
 -> Term -> Flow Graph FieldType)
-> (Map Name Term -> Flow Graph FieldType)
-> Term
-> Flow Graph FieldType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Name -> Type -> FieldType
FieldType
  (Name -> Type -> FieldType)
-> Flow Graph Name -> Flow Graph (Type -> FieldType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term
-> Name -> (Term -> Flow Graph Name) -> Flow Graph Name
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_FieldType_name Term -> Flow Graph Name
coreDecodeName
  Flow Graph (Type -> FieldType)
-> Flow Graph Type -> Flow Graph FieldType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_FieldType_type Term -> Flow Graph Type
coreDecodeType

coreDecodeFieldTypes :: Term -> Flow Graph [FieldType]
coreDecodeFieldTypes :: Term -> Flow Graph [FieldType]
coreDecodeFieldTypes Term
term = case Term -> Term
fullyStripTerm Term
term of
  TermList [Term]
els -> (Term -> Flow Graph FieldType) -> [Term] -> Flow Graph [FieldType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph FieldType
coreDecodeFieldType [Term]
els
  Term
_ -> String -> String -> Flow Graph [FieldType]
forall s x. String -> String -> Flow s x
unexpected String
"list" (String -> Flow Graph [FieldType])
-> String -> Flow Graph [FieldType]
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

coreDecodeFloatType :: Term -> Flow Graph FloatType
coreDecodeFloatType :: Term -> Flow Graph FloatType
coreDecodeFloatType = Name -> [(Name, FloatType)] -> Term -> Flow Graph FloatType
forall b. Name -> [(Name, b)] -> Term -> Flow Graph b
matchEnum Name
_FloatType [
  (Name
_FloatType_bigfloat, FloatType
FloatTypeBigfloat),
  (Name
_FloatType_float32, FloatType
FloatTypeFloat32),
  (Name
_FloatType_float64, FloatType
FloatTypeFloat64)]

coreDecodeFunctionType :: Term -> Flow Graph (FunctionType)
coreDecodeFunctionType :: Term -> Flow Graph FunctionType
coreDecodeFunctionType = (Map Name Term -> Flow Graph FunctionType)
-> Term -> Flow Graph FunctionType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph FunctionType)
 -> Term -> Flow Graph FunctionType)
-> (Map Name Term -> Flow Graph FunctionType)
-> Term
-> Flow Graph FunctionType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Type -> Type -> FunctionType
FunctionType
  (Type -> Type -> FunctionType)
-> Flow Graph Type -> Flow Graph (Type -> FunctionType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_FunctionType_domain Term -> Flow Graph Type
coreDecodeType
  Flow Graph (Type -> FunctionType)
-> Flow Graph Type -> Flow Graph FunctionType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_FunctionType_codomain Term -> Flow Graph Type
coreDecodeType

coreDecodeIntegerType :: Term -> Flow Graph IntegerType
coreDecodeIntegerType :: Term -> Flow Graph IntegerType
coreDecodeIntegerType = Name -> [(Name, IntegerType)] -> Term -> Flow Graph IntegerType
forall b. Name -> [(Name, b)] -> Term -> Flow Graph b
matchEnum Name
_IntegerType [
  (Name
_IntegerType_bigint, IntegerType
IntegerTypeBigint),
  (Name
_IntegerType_int8, IntegerType
IntegerTypeInt8),
  (Name
_IntegerType_int16, IntegerType
IntegerTypeInt16),
  (Name
_IntegerType_int32, IntegerType
IntegerTypeInt32),
  (Name
_IntegerType_int64, IntegerType
IntegerTypeInt64),
  (Name
_IntegerType_uint8, IntegerType
IntegerTypeUint8),
  (Name
_IntegerType_uint16, IntegerType
IntegerTypeUint16),
  (Name
_IntegerType_uint32, IntegerType
IntegerTypeUint32),
  (Name
_IntegerType_uint64, IntegerType
IntegerTypeUint64)]

coreDecodeLambdaType :: Term -> Flow Graph (LambdaType)
coreDecodeLambdaType :: Term -> Flow Graph LambdaType
coreDecodeLambdaType = (Map Name Term -> Flow Graph LambdaType)
-> Term -> Flow Graph LambdaType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph LambdaType)
 -> Term -> Flow Graph LambdaType)
-> (Map Name Term -> Flow Graph LambdaType)
-> Term
-> Flow Graph LambdaType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Name -> Type -> LambdaType
LambdaType
  (Name -> Type -> LambdaType)
-> Flow Graph Name -> Flow Graph (Type -> LambdaType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Name Term
-> Name -> (Term -> Flow Graph Name) -> Flow Graph Name
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_LambdaType_parameter Term -> Flow Graph Name
coreDecodeName)
  Flow Graph (Type -> LambdaType)
-> Flow Graph Type -> Flow Graph LambdaType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_LambdaType_body Term -> Flow Graph Type
coreDecodeType

coreDecodeLiteralType :: Term -> Flow Graph LiteralType
coreDecodeLiteralType :: Term -> Flow Graph LiteralType
coreDecodeLiteralType = Name
-> [(Name, Term -> Flow Graph LiteralType)]
-> Term
-> Flow Graph LiteralType
forall b.
Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion Name
_LiteralType [
  Name -> LiteralType -> (Name, Term -> Flow Graph LiteralType)
forall y x. Name -> y -> (Name, x -> Flow Graph y)
matchUnitField Name
_LiteralType_binary LiteralType
LiteralTypeBinary,
  Name -> LiteralType -> (Name, Term -> Flow Graph LiteralType)
forall y x. Name -> y -> (Name, x -> Flow Graph y)
matchUnitField Name
_LiteralType_boolean LiteralType
LiteralTypeBoolean,
  (Name
_LiteralType_float, (FloatType -> LiteralType)
-> Flow Graph FloatType -> Flow Graph LiteralType
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FloatType -> LiteralType
LiteralTypeFloat (Flow Graph FloatType -> Flow Graph LiteralType)
-> (Term -> Flow Graph FloatType) -> Term -> Flow Graph LiteralType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph FloatType
coreDecodeFloatType),
  (Name
_LiteralType_integer, (IntegerType -> LiteralType)
-> Flow Graph IntegerType -> Flow Graph LiteralType
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntegerType -> LiteralType
LiteralTypeInteger (Flow Graph IntegerType -> Flow Graph LiteralType)
-> (Term -> Flow Graph IntegerType)
-> Term
-> Flow Graph LiteralType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph IntegerType
coreDecodeIntegerType),
  Name -> LiteralType -> (Name, Term -> Flow Graph LiteralType)
forall y x. Name -> y -> (Name, x -> Flow Graph y)
matchUnitField Name
_LiteralType_string LiteralType
LiteralTypeString]

coreDecodeMapType :: Term -> Flow Graph (MapType)
coreDecodeMapType :: Term -> Flow Graph MapType
coreDecodeMapType = (Map Name Term -> Flow Graph MapType) -> Term -> Flow Graph MapType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph MapType)
 -> Term -> Flow Graph MapType)
-> (Map Name Term -> Flow Graph MapType)
-> Term
-> Flow Graph MapType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Type -> Type -> MapType
MapType
  (Type -> Type -> MapType)
-> Flow Graph Type -> Flow Graph (Type -> MapType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_MapType_keys Term -> Flow Graph Type
coreDecodeType
  Flow Graph (Type -> MapType)
-> Flow Graph Type -> Flow Graph MapType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name -> (Term -> Flow Graph Type) -> Flow Graph Type
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_MapType_values Term -> Flow Graph Type
coreDecodeType

coreDecodeName :: Term -> Flow Graph Name
coreDecodeName :: Term -> Flow Graph Name
coreDecodeName Term
term = String -> Name
Name (String -> Name) -> Flow Graph String -> Flow Graph Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Term -> Flow Graph Term
forall s. Name -> Term -> Flow s Term
Expect.wrap Name
_Name Term
term Flow Graph Term -> (Term -> Flow Graph String) -> Flow Graph String
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Term -> Flow Graph String
forall s. Term -> Flow s String
Expect.string)

coreDecodeWrappedType :: Term -> Flow Graph WrappedType
coreDecodeWrappedType :: Term -> Flow Graph WrappedType
coreDecodeWrappedType Term
term = do
  [Field]
fields <- Name -> Term -> Flow Graph [Field]
forall s. Name -> Term -> Flow s [Field]
Expect.recordWithName Name
_WrappedType Term
term
  Name
name <- Name -> (Term -> Flow Graph Name) -> [Field] -> Flow Graph Name
forall s x. Name -> (Term -> Flow s x) -> [Field] -> Flow s x
Expect.field Name
_WrappedType_typeName Term -> Flow Graph Name
coreDecodeName [Field]
fields
  Type
obj <- Name -> (Term -> Flow Graph Type) -> [Field] -> Flow Graph Type
forall s x. Name -> (Term -> Flow s x) -> [Field] -> Flow s x
Expect.field Name
_WrappedType_object Term -> Flow Graph Type
coreDecodeType [Field]
fields
  WrappedType -> Flow Graph WrappedType
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrappedType -> Flow Graph WrappedType)
-> WrappedType -> Flow Graph WrappedType
forall a b. (a -> b) -> a -> b
$ Name -> Type -> WrappedType
WrappedType Name
name Type
obj

coreDecodeRowType :: Term -> Flow Graph (RowType)
coreDecodeRowType :: Term -> Flow Graph RowType
coreDecodeRowType = (Map Name Term -> Flow Graph RowType) -> Term -> Flow Graph RowType
forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord ((Map Name Term -> Flow Graph RowType)
 -> Term -> Flow Graph RowType)
-> (Map Name Term -> Flow Graph RowType)
-> Term
-> Flow Graph RowType
forall a b. (a -> b) -> a -> b
$ \Map Name Term
m -> Name -> [FieldType] -> RowType
RowType
  (Name -> [FieldType] -> RowType)
-> Flow Graph Name -> Flow Graph ([FieldType] -> RowType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Term
-> Name -> (Term -> Flow Graph Name) -> Flow Graph Name
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_RowType_typeName Term -> Flow Graph Name
coreDecodeName
  Flow Graph ([FieldType] -> RowType)
-> Flow Graph [FieldType] -> Flow Graph RowType
forall a b. Flow Graph (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Name Term
-> Name
-> (Term -> Flow Graph [FieldType])
-> Flow Graph [FieldType]
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_RowType_fields Term -> Flow Graph [FieldType]
coreDecodeFieldTypes

coreDecodeString :: Term -> Flow Graph String
coreDecodeString :: Term -> Flow Graph String
coreDecodeString = Term -> Flow Graph String
forall s. Term -> Flow s String
Expect.string (Term -> Flow Graph String)
-> (Term -> Term) -> Term -> Flow Graph String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Term
fullyStripTerm

coreDecodeType :: Term -> Flow Graph Type
coreDecodeType :: Term -> Flow Graph Type
coreDecodeType Term
dat = case Term
dat of
  TermAnnotated (AnnotatedTerm Term
term Map Name Term
ann) -> (\Type
t -> AnnotatedType -> Type
TypeAnnotated (AnnotatedType -> Type) -> AnnotatedType -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Map Name Term -> AnnotatedType
AnnotatedType Type
t Map Name Term
ann) (Type -> Type) -> Flow Graph Type -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Type
coreDecodeType Term
term
  TermTyped (TypedTerm Term
term Type
_) -> Term -> Flow Graph Type
coreDecodeType Term
term
  Term
_ -> Name
-> [(Name, Term -> Flow Graph Type)] -> Term -> Flow Graph Type
forall b.
Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion Name
_Type [
--    (_Type_annotated, fmap TypeAnnotated . coreDecodeAnnotated),
    (Name
_Type_application, (ApplicationType -> Type)
-> Flow Graph ApplicationType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApplicationType -> Type
TypeApplication (Flow Graph ApplicationType -> Flow Graph Type)
-> (Term -> Flow Graph ApplicationType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph ApplicationType
coreDecodeApplicationType),
    (Name
_Type_function, (FunctionType -> Type)
-> Flow Graph FunctionType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunctionType -> Type
TypeFunction (Flow Graph FunctionType -> Flow Graph Type)
-> (Term -> Flow Graph FunctionType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph FunctionType
coreDecodeFunctionType),
    (Name
_Type_lambda, (LambdaType -> Type) -> Flow Graph LambdaType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LambdaType -> Type
TypeLambda (Flow Graph LambdaType -> Flow Graph Type)
-> (Term -> Flow Graph LambdaType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph LambdaType
coreDecodeLambdaType),
    (Name
_Type_list, (Type -> Type) -> Flow Graph Type -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
TypeList (Flow Graph Type -> Flow Graph Type)
-> (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph Type
coreDecodeType),
    (Name
_Type_literal, (LiteralType -> Type) -> Flow Graph LiteralType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LiteralType -> Type
TypeLiteral (Flow Graph LiteralType -> Flow Graph Type)
-> (Term -> Flow Graph LiteralType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph LiteralType
coreDecodeLiteralType),
    (Name
_Type_map, (MapType -> Type) -> Flow Graph MapType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MapType -> Type
TypeMap (Flow Graph MapType -> Flow Graph Type)
-> (Term -> Flow Graph MapType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph MapType
coreDecodeMapType),
    (Name
_Type_optional, (Type -> Type) -> Flow Graph Type -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
TypeOptional (Flow Graph Type -> Flow Graph Type)
-> (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph Type
coreDecodeType),
    (Name
_Type_product, \Term
l -> do
      [Term]
types <- (Term -> Flow Graph Term) -> Term -> Flow Graph [Term]
forall s x. (Term -> Flow s x) -> Term -> Flow s [x]
Expect.list Term -> Flow Graph Term
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
l
      [Type] -> Type
TypeProduct ([Type] -> Type) -> Flow Graph [Type] -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term -> Flow Graph Type) -> [Term] -> Flow Graph [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Type
coreDecodeType [Term]
types)),
    (Name
_Type_record, (RowType -> Type) -> Flow Graph RowType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RowType -> Type
TypeRecord (Flow Graph RowType -> Flow Graph Type)
-> (Term -> Flow Graph RowType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph RowType
coreDecodeRowType),
    (Name
_Type_set, (Type -> Type) -> Flow Graph Type -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
TypeSet (Flow Graph Type -> Flow Graph Type)
-> (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph Type
coreDecodeType),
    (Name
_Type_sum, \(TermList [Term]
types) -> [Type] -> Type
TypeSum ([Type] -> Type) -> Flow Graph [Type] -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term -> Flow Graph Type) -> [Term] -> Flow Graph [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow Graph Type
coreDecodeType [Term]
types)),
    (Name
_Type_union, (RowType -> Type) -> Flow Graph RowType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RowType -> Type
TypeUnion (Flow Graph RowType -> Flow Graph Type)
-> (Term -> Flow Graph RowType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph RowType
coreDecodeRowType),
    (Name
_Type_variable, (Name -> Type) -> Flow Graph Name -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Type
TypeVariable (Flow Graph Name -> Flow Graph Type)
-> (Term -> Flow Graph Name) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Flow Graph Name
coreDecodeName),
    (Name
_Type_wrap, (WrappedType -> Type) -> Flow Graph WrappedType -> Flow Graph Type
forall a b. (a -> b) -> Flow Graph a -> Flow Graph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WrappedType -> Type
TypeWrap (Flow Graph WrappedType -> Flow Graph Type)
-> (Term -> Flow Graph WrappedType) -> Term -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Flow Graph WrappedType
coreDecodeWrappedType))] Term
dat

getField :: M.Map Name (Term) -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField :: forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
fname Term -> Flow Graph b
decode = case Name -> Map Name Term -> Maybe Term
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
fname Map Name Term
m of
  Maybe Term
Nothing -> String -> Flow Graph b
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph b) -> String -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ String
"expected field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
  Just Term
val -> Term -> Flow Graph b
decode Term
val

matchEnum :: Name -> [(Name, b)] -> Term -> Flow Graph b
matchEnum :: forall b. Name -> [(Name, b)] -> Term -> Flow Graph b
matchEnum Name
tname = Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
forall b.
Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion Name
tname ([(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b)
-> ([(Name, b)] -> [(Name, Term -> Flow Graph b)])
-> [(Name, b)]
-> Term
-> Flow Graph b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, b) -> (Name, Term -> Flow Graph b))
-> [(Name, b)] -> [(Name, Term -> Flow Graph b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> b -> (Name, Term -> Flow Graph b))
-> (Name, b) -> (Name, Term -> Flow Graph b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> b -> (Name, Term -> Flow Graph b)
forall y x. Name -> y -> (Name, x -> Flow Graph y)
matchUnitField)

matchRecord :: (M.Map Name (Term) -> Flow Graph b) -> Term -> Flow Graph b
matchRecord :: forall b. (Map Name Term -> Flow Graph b) -> Term -> Flow Graph b
matchRecord Map Name Term -> Flow Graph b
decode Term
term = case Term -> Term
fullyStripTerm Term
term of
  TermRecord (Record Name
_ [Field]
fields) -> Map Name Term -> Flow Graph b
decode (Map Name Term -> Flow Graph b) -> Map Name Term -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ [(Name, Term)] -> Map Name Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Term)] -> Map Name Term)
-> [(Name, Term)] -> Map Name Term
forall a b. (a -> b) -> a -> b
$ (Field -> (Name, Term)) -> [Field] -> [(Name, Term)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Field Name
fname Term
val) -> (Name
fname, Term
val)) [Field]
fields
  Term
_ -> String -> String -> Flow Graph b
forall s x. String -> String -> Flow s x
unexpected String
"record" (String -> Flow Graph b) -> String -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

matchUnion :: Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion :: forall b.
Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion Name
tname [(Name, Term -> Flow Graph b)]
pairs Term
term = case Term -> Term
fullyStripTerm Term
term of
    TermVariable Name
name -> do
      Element
el <- Name -> Flow Graph Element
requireElement Name
name
      Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
forall b.
Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b
matchUnion Name
tname [(Name, Term -> Flow Graph b)]
pairs (Element -> Term
elementData Element
el)
    TermUnion (Injection Name
tname' (Field Name
fname Term
val)) -> if Name
tname' Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
tname
      then case Name
-> Map Name (Term -> Flow Graph b) -> Maybe (Term -> Flow Graph b)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
fname Map Name (Term -> Flow Graph b)
mapping of
        Maybe (Term -> Flow Graph b)
Nothing -> String -> Flow Graph b
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph b) -> String -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ String
"no matching case for field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
fname
        Just Term -> Flow Graph b
f -> Term -> Flow Graph b
f Term
val
      else String -> String -> Flow Graph b
forall s x. String -> String -> Flow s x
unexpected (String
"injection for type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tname) (String -> Flow Graph b) -> String -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term
    Term
t -> String -> String -> Flow Graph b
forall s x. String -> String -> Flow s x
unexpected (String
"union with one of {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " (Name -> String
unName (Name -> String)
-> ((Name, Term -> Flow Graph b) -> Name)
-> (Name, Term -> Flow Graph b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Term -> Flow Graph b) -> Name
forall a b. (a, b) -> a
fst ((Name, Term -> Flow Graph b) -> String)
-> [(Name, Term -> Flow Graph b)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Term -> Flow Graph b)]
pairs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}") (String -> Flow Graph b) -> String -> Flow Graph b
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
t
  where
    mapping :: Map Name (Term -> Flow Graph b)
mapping = [(Name, Term -> Flow Graph b)] -> Map Name (Term -> Flow Graph b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Term -> Flow Graph b)]
pairs

matchUnitField :: Name -> y -> (Name, x -> Flow Graph y)
matchUnitField :: forall y x. Name -> y -> (Name, x -> Flow Graph y)
matchUnitField Name
fname y
x = (Name
fname, \x
_ -> y -> Flow Graph y
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure y
x)