module Hydra.CoreEncoding where

import Hydra.Core
import Hydra.Compute
import Hydra.Mantle
import Hydra.Monads
import Hydra.Impl.Haskell.Dsl.Terms

import Prelude hiding (map)
import qualified Data.Map as M
import qualified Data.Set as S


encodeApplication :: Ord m => Application m -> Term m
encodeApplication :: forall m. Ord m => Application m -> Term m
encodeApplication (Application Term m
lhs Term m
rhs) = forall m. Name -> [Field m] -> Term m
record Name
_Application [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Application_function forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
lhs,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Application_argument forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
rhs]

encodeApplicationType :: ApplicationType m -> Term m
encodeApplicationType :: forall m. ApplicationType m -> Term m
encodeApplicationType (ApplicationType Type m
lhs Type m
rhs) = forall m. Name -> [Field m] -> Term m
record Name
_ApplicationType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_ApplicationType_function forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
lhs,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_ApplicationType_argument forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
rhs]

encodeCaseStatement :: Ord m => CaseStatement m -> Term m
encodeCaseStatement :: forall m. Ord m => CaseStatement m -> Term m
encodeCaseStatement (CaseStatement Name
name [Field m]
cases) = forall m. Name -> [Field m] -> Term m
record Name
_CaseStatement [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_CaseStatement_typeName forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string (Name -> String
unName Name
name),
  forall m. FieldName -> Term m -> Field m
Field FieldName
_CaseStatement_cases forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Field m -> Term m
encodeField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field m]
cases]

encodeElimination :: Ord m => Elimination m -> Term m
encodeElimination :: forall m. Ord m => Elimination m -> Term m
encodeElimination Elimination m
e = case Elimination m
e of
  Elimination m
EliminationElement -> forall m. Name -> FieldName -> Term m
unitVariant Name
_Elimination FieldName
_Elimination_element
  EliminationList Term m
f -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Elimination FieldName
_Elimination_list forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
f
  EliminationNominal (Name String
name) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Elimination FieldName
_Elimination_nominal forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
name
  EliminationOptional OptionalCases m
cases -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Elimination FieldName
_Elimination_optional forall a b. (a -> b) -> a -> b
$ forall m. Ord m => OptionalCases m -> Term m
encodeOptionalCases OptionalCases m
cases
  EliminationRecord Projection
p -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Elimination FieldName
_Elimination_record forall a b. (a -> b) -> a -> b
$ forall m. Projection -> Term m
encodeProjection Projection
p
  EliminationUnion CaseStatement m
c -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Elimination FieldName
_Elimination_union forall a b. (a -> b) -> a -> b
$ forall m. Ord m => CaseStatement m -> Term m
encodeCaseStatement CaseStatement m
c

encodeField :: Ord m => Field m -> Term m
encodeField :: forall m. Ord m => Field m -> Term m
encodeField (Field (FieldName String
name) Term m
term) = forall m. Name -> [Field m] -> Term m
record Name
_Field [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Field_name forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
name,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Field_term forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
term]

encodeFieldType :: FieldType m -> Term m
encodeFieldType :: forall m. FieldType m -> Term m
encodeFieldType (FieldType (FieldName String
fname) Type m
t) = forall m. Name -> [Field m] -> Term m
record Name
_FieldType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_FieldType_name forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
fname,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_FieldType_type forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
t]

encodeFloatType :: FloatType -> Term m
encodeFloatType :: forall m. FloatType -> Term m
encodeFloatType FloatType
ft = forall m. Name -> FieldName -> Term m
unitVariant Name
_FloatType forall a b. (a -> b) -> a -> b
$ case FloatType
ft of
  FloatType
FloatTypeBigfloat -> FieldName
_FloatType_bigfloat
  FloatType
FloatTypeFloat32 -> FieldName
_FloatType_float32
  FloatType
FloatTypeFloat64 -> FieldName
_FloatType_float64

encodeFunction :: Ord m => Function m -> Term m
encodeFunction :: forall m. Ord m => Function m -> Term m
encodeFunction Function m
f = case Function m
f of
  FunctionCompareTo Term m
other -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Function FieldName
_Function_compareTo forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
other
  FunctionElimination Elimination m
e -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Function FieldName
_Function_compareTo forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Elimination m -> Term m
encodeElimination Elimination m
e
  FunctionLambda Lambda m
l -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Function FieldName
_Function_lambda forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Lambda m -> Term m
encodeLambda Lambda m
l
  FunctionPrimitive (Name String
name) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Function FieldName
_Function_primitive forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
name

encodeFunctionType :: FunctionType m -> Term m
encodeFunctionType :: forall m. FunctionType m -> Term m
encodeFunctionType (FunctionType Type m
dom Type m
cod) = forall m. Name -> [Field m] -> Term m
record Name
_FunctionType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_FunctionType_domain forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
dom,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_FunctionType_codomain forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
cod]

encodeIntegerType :: IntegerType -> Term m
encodeIntegerType :: forall m. IntegerType -> Term m
encodeIntegerType IntegerType
it = forall m. Name -> FieldName -> Term m
unitVariant Name
_IntegerType forall a b. (a -> b) -> a -> b
$ case IntegerType
it of
  IntegerType
IntegerTypeBigint -> FieldName
_IntegerType_bigint
  IntegerType
IntegerTypeInt8 -> FieldName
_IntegerType_int8
  IntegerType
IntegerTypeInt16 -> FieldName
_IntegerType_int16
  IntegerType
IntegerTypeInt32 -> FieldName
_IntegerType_int32
  IntegerType
IntegerTypeInt64 -> FieldName
_IntegerType_int64
  IntegerType
IntegerTypeUint8 -> FieldName
_IntegerType_uint8
  IntegerType
IntegerTypeUint16 -> FieldName
_IntegerType_uint16
  IntegerType
IntegerTypeUint32 -> FieldName
_IntegerType_uint32
  IntegerType
IntegerTypeUint64 -> FieldName
_IntegerType_uint64

encodeLambda :: Ord m => Lambda m -> Term m
encodeLambda :: forall m. Ord m => Lambda m -> Term m
encodeLambda (Lambda (Variable String
v) Term m
b) = forall m. Name -> [Field m] -> Term m
record Name
_Lambda [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Lambda_parameter forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
v,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Lambda_body forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
b]

encodeLambdaType :: LambdaType m -> Term m
encodeLambdaType :: forall m. LambdaType m -> Term m
encodeLambdaType (LambdaType (VariableType String
var) Type m
body) = forall m. Name -> [Field m] -> Term m
record Name
_LambdaType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_LambdaType_parameter forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
var,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_LambdaType_body forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
body]

encodeLiteralType :: LiteralType -> Term m
encodeLiteralType :: forall m. LiteralType -> Term m
encodeLiteralType LiteralType
at = case LiteralType
at of
  LiteralType
LiteralTypeBinary -> forall m. Name -> FieldName -> Term m
unitVariant Name
_LiteralType FieldName
_LiteralType_binary
  LiteralType
LiteralTypeBoolean -> forall m. Name -> FieldName -> Term m
unitVariant Name
_LiteralType FieldName
_LiteralType_boolean
  LiteralTypeFloat FloatType
ft -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_LiteralType FieldName
_LiteralType_float forall a b. (a -> b) -> a -> b
$ forall m. FloatType -> Term m
encodeFloatType FloatType
ft
  LiteralTypeInteger IntegerType
it -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_LiteralType FieldName
_LiteralType_integer forall a b. (a -> b) -> a -> b
$ forall m. IntegerType -> Term m
encodeIntegerType IntegerType
it
  LiteralType
LiteralTypeString -> forall m. Name -> FieldName -> Term m
unitVariant Name
_LiteralType FieldName
_LiteralType_string

encodeLiteral :: Literal -> Term m
encodeLiteral :: forall m. Literal -> Term m
encodeLiteral = forall m. Literal -> Term m
literal

encodeLiteralVariant :: LiteralVariant -> Term m
encodeLiteralVariant :: forall m. LiteralVariant -> Term m
encodeLiteralVariant LiteralVariant
av = forall m. Name -> FieldName -> Term m
unitVariant Name
_LiteralVariant forall a b. (a -> b) -> a -> b
$ case LiteralVariant
av of
  LiteralVariant
LiteralVariantBinary -> FieldName
_LiteralVariant_binary
  LiteralVariant
LiteralVariantBoolean -> FieldName
_LiteralVariant_boolean
  LiteralVariant
LiteralVariantFloat -> FieldName
_LiteralVariant_float
  LiteralVariant
LiteralVariantInteger -> FieldName
_LiteralVariant_integer
  LiteralVariant
LiteralVariantString -> FieldName
_LiteralVariant_string

encodeMapType :: MapType m -> Term m
encodeMapType :: forall m. MapType m -> Term m
encodeMapType (MapType Type m
kt Type m
vt) = forall m. Name -> [Field m] -> Term m
record Name
_MapType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_MapType_keys forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
kt,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_MapType_values forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
vt]

encodeNamed :: Ord m => Named m -> Term m
encodeNamed :: forall m. Ord m => Named m -> Term m
encodeNamed (Named (Name String
name) Term m
term) = forall m. Name -> [Field m] -> Term m
record Name
_Named [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Named_typeName forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
name,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Named_term forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
term]

encodeOptionalCases :: Ord m => OptionalCases m -> Term m
encodeOptionalCases :: forall m. Ord m => OptionalCases m -> Term m
encodeOptionalCases (OptionalCases Term m
nothing Term m
just) = forall m. Name -> [Field m] -> Term m
record Name
_OptionalCases [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_OptionalCases_nothing forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
nothing,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_OptionalCases_just forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
just]

encodeProjection :: Projection -> Term m
encodeProjection :: forall m. Projection -> Term m
encodeProjection (Projection Name
name FieldName
fname) = forall m. Name -> [Field m] -> Term m
record Name
_Projection [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Projection_typeName forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string (Name -> String
unName Name
name),
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Projection_field forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string (FieldName -> String
unFieldName FieldName
fname)]

encodeRowType :: RowType m -> Term m
encodeRowType :: forall m. RowType m -> Term m
encodeRowType (RowType Name
name Maybe Name
extends [FieldType m]
fields) = forall m. Name -> [Field m] -> Term m
record Name
_RowType [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_RowType_typeName forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string (Name -> String
unName Name
name),
  forall m. FieldName -> Term m -> Field m
Field FieldName
_RowType_extends forall a b. (a -> b) -> a -> b
$ forall m. Maybe (Term m) -> Term m
optional (forall m. String -> Term m
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
extends),
  forall m. FieldName -> Term m -> Field m
Field FieldName
_RowType_fields forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list forall a b. (a -> b) -> a -> b
$ forall m. FieldType m -> Term m
encodeFieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields]

encodeSum :: Ord m => Sum m -> Term m
encodeSum :: forall m. Ord m => Sum m -> Term m
encodeSum (Sum Int
i Int
l Term m
term) = forall m. Name -> [Field m] -> Term m
record Name
_Sum [
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Sum_index forall a b. (a -> b) -> a -> b
$ forall m. Int -> Term m
int32 Int
i,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Sum_size forall a b. (a -> b) -> a -> b
$ forall m. Int -> Term m
int32 Int
l,
  forall m. FieldName -> Term m -> Field m
Field FieldName
_Sum_term forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm Term m
term]

encodeTerm :: Ord m => Term m -> Term m
encodeTerm :: forall m. Ord m => Term m -> Term m
encodeTerm Term m
term = case Term m
term of
  TermAnnotated (Annotated Term m
t m
ann) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_annotated forall a b. (a -> b) -> a -> b
$ forall m. Annotated (Term m) m -> Term m
TermAnnotated forall a b. (a -> b) -> a -> b
$ forall a m. a -> m -> Annotated a m
Annotated (forall m. Ord m => Term m -> Term m
encodeTerm Term m
t) m
ann
  TermApplication Application m
a -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_application forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Application m -> Term m
encodeApplication Application m
a
  TermLiteral Literal
av -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_literal forall a b. (a -> b) -> a -> b
$ forall m. Literal -> Term m
encodeLiteral Literal
av
  TermElement (Name String
name) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_element forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
name
  TermFunction Function m
f -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_function forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Function m -> Term m
encodeFunction Function m
f
  TermList [Term m]
terms -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_list forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term m]
terms
  TermMap Map (Term m) (Term m)
m -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_map forall a b. (a -> b) -> a -> b
$ forall m. Map (Term m) (Term m) -> Term m
map forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall {m} {m}.
(Ord m, Ord m) =>
(Term m, Term m) -> (Term m, Term m)
encodePair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
M.toList Map (Term m) (Term m)
m
    where encodePair :: (Term m, Term m) -> (Term m, Term m)
encodePair (Term m
k, Term m
v) = (forall m. Ord m => Term m -> Term m
encodeTerm Term m
k, forall m. Ord m => Term m -> Term m
encodeTerm Term m
v)
  TermNominal Named m
ntt -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_nominal forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Named m -> Term m
encodeNamed Named m
ntt
  TermOptional Maybe (Term m)
m -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_optional forall a b. (a -> b) -> a -> b
$ forall m. Maybe (Term m) -> Term m
optional forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term m)
m
  TermProduct [Term m]
terms -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_product forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list (forall m. Ord m => Term m -> Term m
encodeTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term m]
terms)
  TermRecord (Record Name
_ [Field m]
fields) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_record forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Field m -> Term m
encodeField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field m]
fields
  TermSet Set (Term m)
terms -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_set forall a b. (a -> b) -> a -> b
$ forall m. Set (Term m) -> Term m
set forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Term m -> Term m
encodeTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList Set (Term m)
terms
  TermSum Sum m
s -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_sum forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Sum m -> Term m
encodeSum Sum m
s
  TermUnion (Union Name
_ Field m
field) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_union forall a b. (a -> b) -> a -> b
$ forall m. Ord m => Field m -> Term m
encodeField Field m
field
  TermVariable (Variable String
var) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Term FieldName
_Term_variable forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
var

encodeType :: Type m -> Term m
encodeType :: forall m. Type m -> Term m
encodeType Type m
typ = case Type m
typ of
  TypeAnnotated (Annotated Type m
t m
ann) -> forall m. Annotated (Term m) m -> Term m
TermAnnotated (forall a m. a -> m -> Annotated a m
Annotated (forall m. Type m -> Term m
encodeType Type m
t) m
ann)
  TypeApplication ApplicationType m
a -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_application forall a b. (a -> b) -> a -> b
$ forall m. ApplicationType m -> Term m
encodeApplicationType ApplicationType m
a
  TypeElement Type m
t -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_element forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
t
  TypeFunction FunctionType m
ft -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_function forall a b. (a -> b) -> a -> b
$ forall m. FunctionType m -> Term m
encodeFunctionType FunctionType m
ft
  TypeLambda LambdaType m
ut -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_lambda forall a b. (a -> b) -> a -> b
$ forall m. LambdaType m -> Term m
encodeLambdaType LambdaType m
ut
  TypeList Type m
t -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_list forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
t
  TypeLiteral LiteralType
at -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_literal forall a b. (a -> b) -> a -> b
$ forall m. LiteralType -> Term m
encodeLiteralType LiteralType
at
  TypeMap MapType m
mt -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_map forall a b. (a -> b) -> a -> b
$ forall m. MapType m -> Term m
encodeMapType MapType m
mt
  TypeNominal Name
name -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_nominal forall a b. (a -> b) -> a -> b
$ forall m. Name -> Term m
element Name
name
  TypeOptional Type m
t -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_optional forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
t
  TypeProduct [Type m]
types -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_product forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list (forall m. Type m -> Term m
encodeType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type m]
types)
  TypeRecord RowType m
rt -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_record forall a b. (a -> b) -> a -> b
$ forall m. RowType m -> Term m
encodeRowType RowType m
rt
  TypeSet Type m
t -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_set forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Term m
encodeType Type m
t
  TypeSum [Type m]
types -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_sum forall a b. (a -> b) -> a -> b
$ forall m. [Term m] -> Term m
list (forall m. Type m -> Term m
encodeType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type m]
types)
  TypeUnion RowType m
rt -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_union forall a b. (a -> b) -> a -> b
$ forall m. RowType m -> Term m
encodeRowType RowType m
rt
  TypeVariable (VariableType String
var) -> forall m. Name -> FieldName -> Term m -> Term m
variant Name
_Type FieldName
_Type_variable forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
string String
var

encodeTypeVariant :: TypeVariant -> Term m
encodeTypeVariant :: forall m. TypeVariant -> Term m
encodeTypeVariant TypeVariant
tv = forall m. Name -> FieldName -> Term m
unitVariant Name
_TypeVariant forall a b. (a -> b) -> a -> b
$ case TypeVariant
tv of
  TypeVariant
TypeVariantAnnotated -> FieldName
_TypeVariant_annotated
  TypeVariant
TypeVariantLiteral -> FieldName
_TypeVariant_literal
  TypeVariant
TypeVariantElement -> FieldName
_TypeVariant_element
  TypeVariant
TypeVariantFunction -> FieldName
_TypeVariant_function
  TypeVariant
TypeVariantList -> FieldName
_TypeVariant_list
  TypeVariant
TypeVariantMap -> FieldName
_TypeVariant_map
  TypeVariant
TypeVariantNominal -> FieldName
_TypeVariant_nominal
  TypeVariant
TypeVariantOptional -> FieldName
_TypeVariant_optional
  TypeVariant
TypeVariantProduct -> FieldName
_TypeVariant_product
  TypeVariant
TypeVariantRecord -> FieldName
_TypeVariant_record
  TypeVariant
TypeVariantSet -> FieldName
_TypeVariant_set
  TypeVariant
TypeVariantSum -> FieldName
_TypeVariant_sum
  TypeVariant
TypeVariantUnion -> FieldName
_TypeVariant_union
  TypeVariant
TypeVariantLambda -> FieldName
_TypeVariant_lambda
  TypeVariant
TypeVariantVariable -> FieldName
_TypeVariant_variable