-- | 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,
  dereferenceType,
  elementAsTypedTerm,
  fieldTypes,
  fullyStripTerm,
  isSerializable,
  moduleDependencyNamespaces,
  requireRecordType,
  requireType,
  requireUnionType,
  requireWrappedType,
  resolveType,
  typeDependencies,
  typeDependencyNames,
  ) 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 -> Maybe Name -> [FieldType] -> RowType
RowType
  (Name -> Maybe Name -> [FieldType] -> RowType)
-> Flow Graph Name
-> Flow Graph (Maybe Name -> [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 (Maybe Name -> [FieldType] -> RowType)
-> Flow Graph (Maybe Name) -> Flow Graph ([FieldType] -> 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 (Maybe Name))
-> Flow Graph (Maybe Name)
forall b.
Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b
getField Map Name Term
m Name
_RowType_extends ((Term -> Flow Graph Name) -> Term -> Flow Graph (Maybe Name)
forall s x. (Term -> Flow s x) -> Term -> Flow s (Maybe x)
Expect.optional 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 String Term
ann) -> (\Type
t -> AnnotatedType -> Type
TypeAnnotated (AnnotatedType -> Type) -> AnnotatedType -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Map String Term -> AnnotatedType
AnnotatedType Type
t Map String 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
  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

dereferenceType :: Name -> Flow Graph (Maybe Type)
dereferenceType :: Name -> Flow Graph (Maybe Type)
dereferenceType Name
name = do
  Maybe Element
mel <- Name -> Flow Graph (Maybe Element)
dereferenceElement Name
name
  case Maybe Element
mel of
    Maybe Element
Nothing -> Maybe Type -> Flow Graph (Maybe Type)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
forall a. Maybe a
Nothing
    Just Element
el -> Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Flow Graph Type -> Flow Graph (Maybe Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Type
coreDecodeType (Element -> Term
elementData Element
el)

elementAsTypedTerm :: Element -> Flow Graph TypedTerm
elementAsTypedTerm :: Element -> Flow Graph TypedTerm
elementAsTypedTerm Element
el = do
  Type
typ <- Term -> Flow Graph Type
requireTermType (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el
  TypedTerm -> Flow Graph TypedTerm
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedTerm -> Flow Graph TypedTerm)
-> TypedTerm -> Flow Graph TypedTerm
forall a b. (a -> b) -> a -> b
$ Term -> Type -> TypedTerm
TypedTerm (Element -> Term
elementData Element
el) Type
typ

fieldTypes :: Type -> Flow Graph (M.Map Name Type)
fieldTypes :: Type -> Flow Graph (Map Name Type)
fieldTypes Type
t = case Type -> Type
stripType Type
t of
    TypeLambda (LambdaType Name
_ Type
body) -> Type -> Flow Graph (Map Name Type)
fieldTypes Type
body
    TypeRecord RowType
rt -> Map Name Type -> Flow Graph (Map Name Type)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Name Type -> Flow Graph (Map Name Type))
-> Map Name Type -> Flow Graph (Map Name Type)
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Map Name Type
toMap ([FieldType] -> Map Name Type) -> [FieldType] -> Map Name Type
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
    TypeUnion RowType
rt -> Map Name Type -> Flow Graph (Map Name Type)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Name Type -> Flow Graph (Map Name Type))
-> Map Name Type -> Flow Graph (Map Name Type)
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Map Name Type
toMap ([FieldType] -> Map Name Type) -> [FieldType] -> Map Name Type
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
    TypeVariable Name
name -> do
      String -> Flow Graph (Map Name Type) -> Flow Graph (Map Name Type)
forall s a. String -> Flow s a -> Flow s a
withTrace (String
"field types of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (Flow Graph (Map Name Type) -> Flow Graph (Map Name Type))
-> Flow Graph (Map Name Type) -> Flow Graph (Map Name Type)
forall a b. (a -> b) -> a -> b
$ do
        Element
el <- Name -> Flow Graph Element
requireElement Name
name
        Term -> Flow Graph Type
coreDecodeType (Element -> Term
elementData Element
el) Flow Graph Type
-> (Type -> Flow Graph (Map Name Type))
-> Flow Graph (Map Name Type)
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
>>= Type -> Flow Graph (Map Name Type)
fieldTypes
    Type
_ -> String -> String -> Flow Graph (Map Name Type)
forall s x. String -> String -> Flow s x
unexpected String
"record or union type" (String -> Flow Graph (Map Name Type))
-> String -> Flow Graph (Map Name Type)
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show Type
t
  where
    toMap :: [FieldType] -> Map Name Type
toMap [FieldType]
fields = [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (FieldType -> (Name, Type)
toPair (FieldType -> (Name, Type)) -> [FieldType] -> [(Name, Type)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)
    toPair :: FieldType -> (Name, Type)
toPair (FieldType Name
fname Type
ftype) = (Name
fname, Type
ftype)

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

isSerializable :: Element -> Flow Graph Bool
isSerializable :: Element -> Flow Graph Bool
isSerializable Element
el = do
    Map Name Type
deps <- Name -> Flow Graph (Map Name Type)
typeDependencies (Element -> Name
elementName Element
el)
    let allVariants :: Set TypeVariant
allVariants = [TypeVariant] -> Set TypeVariant
forall a. Ord a => [a] -> Set a
S.fromList ([TypeVariant] -> Set TypeVariant)
-> [TypeVariant] -> Set TypeVariant
forall a b. (a -> b) -> a -> b
$ [[TypeVariant]] -> [TypeVariant]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Type -> [TypeVariant]
variants (Type -> [TypeVariant]) -> [Type] -> [[TypeVariant]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Type -> [Type]
forall k a. Map k a -> [a]
M.elems Map Name Type
deps)
    Bool -> Flow Graph Bool
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Flow Graph Bool) -> Bool -> Flow Graph Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TypeVariant -> Set TypeVariant -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TypeVariant
TypeVariantFunction Set TypeVariant
allVariants
  where
    variants :: Type -> [TypeVariant]
variants Type
typ = Type -> TypeVariant
typeVariant (Type -> TypeVariant) -> [Type] -> [TypeVariant]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraversalOrder
-> ([Type] -> Type -> [Type]) -> [Type] -> Type -> [Type]
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
TraversalOrderPre (\[Type]
m Type
t -> Type
tType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
m) [] Type
typ

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)

-- | Find dependency namespaces in various dimensions of a term: va
moduleDependencyNamespaces :: Bool -> Bool -> Bool -> Bool -> Module -> Flow Graph (S.Set Namespace)
moduleDependencyNamespaces :: Bool
-> Bool -> Bool -> Bool -> Module -> Flow Graph (Set Namespace)
moduleDependencyNamespaces Bool
withVars Bool
withPrims Bool
withNoms Bool
withSchema Module
mod = do
    Set Name
allNames <- [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Name] -> Set Name)
-> Flow Graph [Set Name] -> Flow Graph (Set Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> Flow Graph (Set Name))
-> [Element] -> Flow Graph [Set Name]
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 Element -> Flow Graph (Set Name)
elNames ([Element] -> Flow Graph [Set Name])
-> [Element] -> Flow Graph [Set Name]
forall a b. (a -> b) -> a -> b
$ Module -> [Element]
moduleElements Module
mod)
    let namespaces :: Set Namespace
namespaces = [Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
S.fromList ([Namespace] -> Set Namespace) -> [Namespace] -> Set Namespace
forall a b. (a -> b) -> a -> b
$ [Maybe Namespace] -> [Namespace]
forall a. [Maybe a] -> [a]
Y.catMaybes (Name -> Maybe Namespace
namespaceOfEager (Name -> Maybe Namespace) -> [Name] -> [Maybe Namespace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> [Name]
forall a. Set a -> [a]
S.toList Set Name
allNames)
    Set Namespace -> Flow Graph (Set Namespace)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Namespace -> Flow Graph (Set Namespace))
-> Set Namespace -> Flow Graph (Set Namespace)
forall a b. (a -> b) -> a -> b
$ Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
S.delete (Module -> Namespace
moduleNamespace Module
mod) Set Namespace
namespaces
  where
    elNames :: Element -> Flow Graph (Set Name)
elNames Element
el = do
      let term :: Term
term = Element -> Term
elementData Element
el
      let dataNames :: Set Name
dataNames = Bool -> Bool -> Bool -> Term -> Set Name
termDependencyNames Bool
withVars Bool
withPrims Bool
withNoms Term
term

      Set Name
schemaNames <- if Bool
withSchema
        then Type -> Set Name
typeDependencyNames (Type -> Set Name) -> Flow Graph Type -> Flow Graph (Set Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Type
requireTermType Term
term
        else Set Name -> Flow Graph (Set Name)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Name
forall a. Set a
S.empty

      Set Name
typeNames <- if Term -> Bool
isEncodedType (Term -> Term
fullyStripTerm Term
term)
        then Type -> Set Name
typeDependencyNames (Type -> Set Name) -> Flow Graph Type -> Flow Graph (Set Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Type
coreDecodeType Term
term
        else Set Name -> Flow Graph (Set Name)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Name
forall a. Set a
S.empty

      Set Name -> Flow Graph (Set Name)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Name -> Flow Graph (Set Name))
-> Set Name -> Flow Graph (Set Name)
forall a b. (a -> b) -> a -> b
$ [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Set Name
dataNames, Set Name
schemaNames, Set Name
typeNames]

requireRecordType :: Bool -> Name -> Flow Graph (RowType)
requireRecordType :: Bool -> Name -> Flow Graph RowType
requireRecordType Bool
infer = String
-> Bool -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
requireRowType String
"record type" Bool
infer ((Type -> Maybe RowType) -> Name -> Flow Graph RowType)
-> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
forall a b. (a -> b) -> a -> b
$ \Type
t -> case Type
t of
  TypeRecord RowType
rt -> RowType -> Maybe RowType
forall a. a -> Maybe a
Just RowType
rt
  Type
_ -> Maybe RowType
forall a. Maybe a
Nothing

requireRowType :: String -> Bool -> (Type -> Maybe (RowType)) -> Name -> Flow Graph (RowType)
requireRowType :: String
-> Bool -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
requireRowType String
label Bool
infer Type -> Maybe RowType
getter Name
name = do
  Type
t <- Name -> Flow Graph Type
requireType Name
name
  case Type -> Maybe RowType
getter (Type -> Type
rawType Type
t) of
    Just RowType
rt -> if Bool
infer
      then case RowType -> Maybe Name
rowTypeExtends RowType
rt of
        Maybe Name
Nothing -> RowType -> Flow Graph RowType
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return RowType
rt
        Just Name
name' -> do
          RowType
rt' <- String
-> Bool -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
requireRowType String
label Bool
True Type -> Maybe RowType
getter Name
name'
          RowType -> Flow Graph RowType
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (RowType -> Flow Graph RowType) -> RowType -> Flow Graph RowType
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
name Maybe Name
forall a. Maybe a
Nothing (RowType -> [FieldType]
rowTypeFields RowType
rt' [FieldType] -> [FieldType] -> [FieldType]
forall a. [a] -> [a] -> [a]
++ RowType -> [FieldType]
rowTypeFields RowType
rt)
      else RowType -> Flow Graph RowType
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return RowType
rt
    Maybe RowType
Nothing -> String -> Flow Graph RowType
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph RowType) -> String -> Flow Graph RowType
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not resolve to a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t
  where
    rawType :: Type -> Type
rawType Type
t = case Type
t of
      TypeAnnotated (AnnotatedType Type
t' Map String Term
_) -> Type -> Type
rawType Type
t'
      TypeLambda (LambdaType Name
_ Type
body) -> Type -> Type
rawType Type
body -- Note: throwing away quantification here
      Type
_ -> Type
t

requireType :: Name -> Flow Graph Type
requireType :: Name -> Flow Graph Type
requireType Name
name = String -> Flow Graph Type -> Flow Graph Type
forall s a. String -> Flow s a -> Flow s a
withTrace (String
"require type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (Flow Graph Type -> Flow Graph Type)
-> Flow Graph Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$
  (Flow Graph Element -> Flow Graph Element
forall x. Flow Graph x -> Flow Graph x
withSchemaContext (Flow Graph Element -> Flow Graph Element)
-> Flow Graph Element -> Flow Graph Element
forall a b. (a -> b) -> a -> b
$ Name -> Flow Graph Element
requireElement Name
name) Flow Graph Element
-> (Element -> Flow Graph Type) -> Flow Graph Type
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 Type
coreDecodeType (Term -> Flow Graph Type)
-> (Element -> Term) -> Element -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Term
elementData)

requireUnionType :: Bool -> Name -> Flow Graph (RowType)
requireUnionType :: Bool -> Name -> Flow Graph RowType
requireUnionType Bool
infer = String
-> Bool -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
requireRowType String
"union" Bool
infer ((Type -> Maybe RowType) -> Name -> Flow Graph RowType)
-> (Type -> Maybe RowType) -> Name -> Flow Graph RowType
forall a b. (a -> b) -> a -> b
$ \Type
t -> case Type
t of
  TypeUnion RowType
rt -> RowType -> Maybe RowType
forall a. a -> Maybe a
Just RowType
rt
  Type
_ -> Maybe RowType
forall a. Maybe a
Nothing

requireWrappedType :: Name -> Flow Graph Type
requireWrappedType :: Name -> Flow Graph Type
requireWrappedType Name
name = do
  Type
typ <- Name -> Flow Graph Type
requireType Name
name
  case Type -> Type
stripType Type
typ of
    TypeWrap (WrappedType Name
name Type
t) -> Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
    Type
_ -> Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
typ -- TODO: stop allowing this "slop" once typedefs are clearly separated from newtypes
--     _ -> fail $ "expected wrapped type for " ++ unName name ++ " but got " ++ show typ

resolveType :: Type -> Flow Graph (Maybe Type)
resolveType :: Type -> Flow Graph (Maybe Type)
resolveType Type
typ = case Type -> Type
stripType Type
typ of
    TypeVariable Name
name -> Flow Graph (Maybe Type) -> Flow Graph (Maybe Type)
forall x. Flow Graph x -> Flow Graph x
withSchemaContext (Flow Graph (Maybe Type) -> Flow Graph (Maybe Type))
-> Flow Graph (Maybe Type) -> Flow Graph (Maybe Type)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Term
mterm <- Name -> Flow Graph (Maybe Term)
resolveTerm Name
name
      case Maybe Term
mterm of
        Maybe Term
Nothing -> Maybe Type -> Flow Graph (Maybe Type)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Type
forall a. Maybe a
Nothing
        Just Term
t -> Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Flow Graph Type -> Flow Graph (Maybe Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Type
coreDecodeType Term
t
    Type
_ -> Maybe Type -> Flow Graph (Maybe Type)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Type -> Flow Graph (Maybe Type))
-> Maybe Type -> Flow Graph (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typ

typeDependencies :: Name -> Flow Graph (M.Map Name Type)
typeDependencies :: Name -> Flow Graph (Map Name Type)
typeDependencies Name
name = Set Name -> Map Name Type -> Flow Graph (Map Name Type)
deps ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name
name]) Map Name Type
forall k a. Map k a
M.empty
  where
    deps :: Set Name -> Map Name Type -> Flow Graph (Map Name Type)
deps Set Name
seeds Map Name Type
names = if Set Name -> Bool
forall a. Set a -> Bool
S.null Set Name
seeds
        then Map Name Type -> Flow Graph (Map Name Type)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Name Type
names
        else do
          [(Name, Type)]
pairs <- (Name -> Flow Graph (Name, Type))
-> [Name] -> Flow Graph [(Name, 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 Name -> Flow Graph (Name, Type)
toPair ([Name] -> Flow Graph [(Name, Type)])
-> [Name] -> Flow Graph [(Name, Type)]
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
S.toList Set Name
seeds
          let newNames :: Map Name Type
newNames = Map Name Type -> Map Name Type -> Map Name Type
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Name Type
names ([(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Type)]
pairs)
          let refs :: Set Name
refs = (Set Name -> Set Name -> Set Name)
-> Set Name -> [Set Name] -> Set Name
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Name
forall a. Set a
S.empty (Type -> Set Name
typeDependencyNames (Type -> Set Name) -> [Type] -> [Set Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, Type) -> Type
forall a b. (a, b) -> b
snd ((Name, Type) -> Type) -> [(Name, Type)] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Type)]
pairs))
          let visited :: Set Name
visited = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ Map Name Type -> [Name]
forall k a. Map k a -> [k]
M.keys Map Name Type
names
          let newSeeds :: Set Name
newSeeds = Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set Name
refs Set Name
visited
          Set Name -> Map Name Type -> Flow Graph (Map Name Type)
deps Set Name
newSeeds Map Name Type
newNames
      where
        toPair :: Name -> Flow Graph (Name, Type)
toPair Name
name = do
          Type
typ <- Name -> Flow Graph Type
requireType Name
name
          (Name, Type) -> Flow Graph (Name, Type)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Type
typ)

    requireType :: Name -> Flow Graph Type
requireType Name
name = do
      String -> Flow Graph Type -> Flow Graph Type
forall s a. String -> Flow s a -> Flow s a
withTrace (String
"type dependencies of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (Flow Graph Type -> Flow Graph Type)
-> Flow Graph Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ do
        Element
el <- Name -> Flow Graph Element
requireElement Name
name
        Term -> Flow Graph Type
coreDecodeType (Element -> Term
elementData Element
el)