module Hydra.Dsl.Core where

import Hydra.Kernel
import Hydra.Dsl.Base as Base

import qualified Data.Map as M
import qualified Data.Maybe as Y


annotatedTerm :: Datum Term -> Datum (M.Map String Term) -> Datum AnnotatedTerm
annotatedTerm :: Datum Term -> Datum (Map String Term) -> Datum AnnotatedTerm
annotatedTerm Datum Term
subject Datum (Map String Term)
annotation = Name -> [Field] -> Datum AnnotatedTerm
forall a. Name -> [Field] -> Datum a
Base.record Name
_AnnotatedTerm [
    Name
_AnnotatedTerm_subjectName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
subject,
    Name
_AnnotatedTerm_annotationName -> Datum (Map String Term) -> Field
forall a. Name -> Datum a -> Field
>>: Datum (Map String Term)
annotation]

annotatedTermSubject :: Datum (AnnotatedTerm -> Term)
annotatedTermSubject :: Datum (AnnotatedTerm -> Term)
annotatedTermSubject = Name -> Name -> Datum (AnnotatedTerm -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_AnnotatedTerm Name
_AnnotatedTerm_subject

annotatedTermAnnotation :: Datum (AnnotatedTerm -> M.Map String Term)
annotatedTermAnnotation :: Datum (AnnotatedTerm -> Map String Term)
annotatedTermAnnotation = Name -> Name -> Datum (AnnotatedTerm -> Map String Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_AnnotatedTerm Name
_AnnotatedTerm_annotation

annotatedType :: Datum Type -> Datum (M.Map String Term) -> Datum AnnotatedType
annotatedType :: Datum Type -> Datum (Map String Term) -> Datum AnnotatedType
annotatedType Datum Type
subject Datum (Map String Term)
annotation = Name -> [Field] -> Datum AnnotatedType
forall a. Name -> [Field] -> Datum a
Base.record Name
_AnnotatedType [
    Name
_AnnotatedType_subjectName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
subject,
    Name
_AnnotatedType_annotationName -> Datum (Map String Term) -> Field
forall a. Name -> Datum a -> Field
>>: Datum (Map String Term)
annotation]

annotatedTypeSubject :: Datum (AnnotatedType -> Type)
annotatedTypeSubject :: Datum (AnnotatedType -> Type)
annotatedTypeSubject = Name -> Name -> Datum (AnnotatedType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_AnnotatedType Name
_AnnotatedType_subject

annotatedTypeAnnotation :: Datum (AnnotatedType -> M.Map String Term)
annotatedTypeAnnotation :: Datum (AnnotatedType -> Map String Term)
annotatedTypeAnnotation = Name -> Name -> Datum (AnnotatedType -> Map String Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_AnnotatedType Name
_AnnotatedType_annotation

application :: Datum Term -> Datum Term -> Datum (Application)
application :: Datum Term -> Datum Term -> Datum Application
application Datum Term
function Datum Term
argument = Name -> [Field] -> Datum Application
forall a. Name -> [Field] -> Datum a
Base.record Name
_Application [
    Name
_Application_functionName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
function,
    Name
_Application_argumentName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
argument]

applicationFunction :: Datum (Application -> Term)
applicationFunction :: Datum (Application -> Term)
applicationFunction = Name -> Name -> Datum (Application -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Application Name
_Application_function

applicationArgument :: Datum (Application -> Term)
applicationArgument :: Datum (Application -> Term)
applicationArgument = Name -> Name -> Datum (Application -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Application Name
_Application_argument

applicationType :: Datum Type -> Datum Type -> Datum (ApplicationType)
applicationType :: Datum Type -> Datum Type -> Datum ApplicationType
applicationType Datum Type
function Datum Type
argument = Name -> [Field] -> Datum ApplicationType
forall a. Name -> [Field] -> Datum a
Base.record Name
_ApplicationType [
    Name
_ApplicationType_functionName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
function,
    Name
_ApplicationType_argumentName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
argument]

applicationTypeFunction :: Datum (ApplicationType -> Type)
applicationTypeFunction :: Datum (ApplicationType -> Type)
applicationTypeFunction = Name -> Name -> Datum (ApplicationType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_ApplicationType Name
_ApplicationType_function

applicationTypeArgument :: Datum (ApplicationType -> Type)
applicationTypeArgument :: Datum (ApplicationType -> Type)
applicationTypeArgument = Name -> Name -> Datum (ApplicationType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_ApplicationType Name
_ApplicationType_argument

caseStatement :: Datum Name -> Datum (Maybe Term) -> Datum [Field] -> Datum (CaseStatement)
caseStatement :: Datum Name
-> Datum (Maybe Term) -> Datum [Field] -> Datum CaseStatement
caseStatement Datum Name
typeName Datum (Maybe Term)
defaultTerm Datum [Field]
cases = Name -> [Field] -> Datum CaseStatement
forall a. Name -> [Field] -> Datum a
Base.record Name
_CaseStatement [
    Name
_CaseStatement_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_CaseStatement_defaultName -> Datum (Maybe Term) -> Field
forall a. Name -> Datum a -> Field
>>: Datum (Maybe Term)
defaultTerm,
    Name
_CaseStatement_casesName -> Datum [Field] -> Field
forall a. Name -> Datum a -> Field
>>: Datum [Field]
cases]

caseStatementTypeName :: Datum (CaseStatement -> Name)
caseStatementTypeName :: Datum (CaseStatement -> Name)
caseStatementTypeName = Name -> Name -> Datum (CaseStatement -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_CaseStatement Name
_CaseStatement_typeName

caseStatementDefault :: Datum (CaseStatement -> Maybe Term)
caseStatementDefault :: Datum (CaseStatement -> Maybe Term)
caseStatementDefault = Name -> Name -> Datum (CaseStatement -> Maybe Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_CaseStatement Name
_CaseStatement_default

caseStatementCases :: Datum (CaseStatement -> [Field])
caseStatementCases :: Datum (CaseStatement -> [Field])
caseStatementCases = Name -> Name -> Datum (CaseStatement -> [Field])
forall a b. Name -> Name -> Datum (a -> b)
project Name
_CaseStatement Name
_CaseStatement_cases

field :: Datum Name -> Datum Term -> Datum Field
field :: Datum Name -> Datum Term -> Datum Field
field Datum Name
name Datum Term
term = Name -> [Field] -> Datum Field
forall a. Name -> [Field] -> Datum a
Base.record Name
_Field [
    Name
_Field_nameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
name,
    Name
_Field_termName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
term]

fieldName :: Datum (Field -> Name)
fieldName :: Datum (Field -> Name)
fieldName = Name -> Name -> Datum (Field -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Field Name
_Field_name

fieldTerm :: Datum (Field -> Term)
fieldTerm :: Datum (Field -> Term)
fieldTerm = Name -> Name -> Datum (Field -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Field Name
_Field_term

fieldType :: Datum Name -> Datum Type -> Datum (FieldType)
fieldType :: Datum Name -> Datum Type -> Datum FieldType
fieldType Datum Name
name Datum Type
typ = Name -> [Field] -> Datum FieldType
forall a. Name -> [Field] -> Datum a
Base.record Name
_FieldType [
    Name
_FieldType_nameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
name,
    Name
_FieldType_typeName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
typ]

fieldTypeName :: Datum (FieldType -> Name)
fieldTypeName :: Datum (FieldType -> Name)
fieldTypeName = Name -> Name -> Datum (FieldType -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FieldType Name
_FieldType_name

fieldTypeType :: Datum (FieldType -> Type)
fieldTypeType :: Datum (FieldType -> Type)
fieldTypeType = Name -> Name -> Datum (FieldType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FieldType Name
_FieldType_type

functionType :: Datum Type -> Datum Type -> Datum (FunctionType)
functionType :: Datum Type -> Datum Type -> Datum FunctionType
functionType Datum Type
domain Datum Type
codomain = Name -> [Field] -> Datum FunctionType
forall a. Name -> [Field] -> Datum a
Base.record Name
_FunctionType [
    Name
_FunctionType_domainName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
domain,
    Name
_FunctionType_codomainName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
codomain]

functionTypeDomain :: Datum (FunctionType -> Type)
functionTypeDomain :: Datum (FunctionType -> Type)
functionTypeDomain = Name -> Name -> Datum (FunctionType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FunctionType Name
_FunctionType_domain

functionTypeCodomain :: Datum (FunctionType -> Type)
functionTypeCodomain :: Datum (FunctionType -> Type)
functionTypeCodomain = Name -> Name -> Datum (FunctionType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_FunctionType Name
_FunctionType_codomain

injection :: Datum Name -> Datum Field -> Datum Injection
injection :: Datum Name -> Datum Field -> Datum Injection
injection Datum Name
typeName Datum Field
field = Name -> [Field] -> Datum Injection
forall a. Name -> [Field] -> Datum a
Base.record Name
_Injection [
    Name
_Injection_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_Injection_fieldName -> Datum Field -> Field
forall a. Name -> Datum a -> Field
>>: Datum Field
field]

injectionTypeName :: Datum (Injection -> Name)
injectionTypeName :: Datum (Injection -> Name)
injectionTypeName = Name -> Name -> Datum (Injection -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Injection Name
_Injection_typeName

injectionField :: Datum (Injection -> Field)
injectionField :: Datum (Injection -> Field)
injectionField = Name -> Name -> Datum (Injection -> Field)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Injection Name
_Injection_field

lambda :: Datum Name -> Datum Term -> Datum Lambda
lambda :: Datum Name -> Datum Term -> Datum Lambda
lambda Datum Name
parameter Datum Term
body = Name -> [Field] -> Datum Lambda
forall a. Name -> [Field] -> Datum a
Base.record Name
_Lambda [
    Name
_Lambda_parameterName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
parameter,
    Name
_Lambda_bodyName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
body]

lambdaParameter :: Datum (Lambda -> Name)
lambdaParameter :: Datum (Lambda -> Name)
lambdaParameter = Name -> Name -> Datum (Lambda -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Lambda Name
_Lambda_parameter

lambdaBody :: Datum (Lambda -> Term)
lambdaBody :: Datum (Lambda -> Term)
lambdaBody = Name -> Name -> Datum (Lambda -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Lambda Name
_Lambda_body

lambdaType :: Datum Name -> Datum Type -> Datum LambdaType
lambdaType :: Datum Name -> Datum Type -> Datum LambdaType
lambdaType Datum Name
parameter Datum Type
body = Name -> [Field] -> Datum LambdaType
forall a. Name -> [Field] -> Datum a
Base.record Name
_LambdaType [
    Name
_LambdaType_parameterName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
parameter,
    Name
_LambdaType_bodyName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
body]

lambdaTypeParameter :: Datum (LambdaType -> Name)
lambdaTypeParameter :: Datum (LambdaType -> Name)
lambdaTypeParameter = Name -> Name -> Datum (LambdaType -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LambdaType Name
_LambdaType_parameter

lambdaTypeBody :: Datum (LambdaType -> Type)
lambdaTypeBody :: Datum (LambdaType -> Type)
lambdaTypeBody = Name -> Name -> Datum (LambdaType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LambdaType Name
_LambdaType_body

letExpression :: Datum [LetBinding] -> Datum Term -> Datum Let
letExpression :: Datum [LetBinding] -> Datum Term -> Datum Let
letExpression Datum [LetBinding]
bindings Datum Term
environment = Name -> [Field] -> Datum Let
forall a. Name -> [Field] -> Datum a
Base.record Name
_Let [
    Name
_Let_bindingsName -> Datum [LetBinding] -> Field
forall a. Name -> Datum a -> Field
>>: Datum [LetBinding]
bindings,
    Name
_Let_environmentName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
environment]

letBindings :: Datum (Let -> [LetBinding])
letBindings :: Datum (Let -> [LetBinding])
letBindings = Name -> Name -> Datum (Let -> [LetBinding])
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Let Name
_Let_bindings

letBindingName :: Datum (LetBinding -> Name)
letBindingName :: Datum (LetBinding -> Name)
letBindingName = Name -> Name -> Datum (LetBinding -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LetBinding Name
_LetBinding_name

letBindingTerm :: Datum (LetBinding -> Term)
letBindingTerm :: Datum (LetBinding -> Term)
letBindingTerm = Name -> Name -> Datum (LetBinding -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LetBinding Name
_LetBinding_term

letBindingType :: Datum (LetBinding -> Y.Maybe TypeScheme)
letBindingType :: Datum (LetBinding -> Maybe TypeScheme)
letBindingType = Name -> Name -> Datum (LetBinding -> Maybe TypeScheme)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_LetBinding Name
_LetBinding_type

letEnvironment :: Datum (Let -> Term)
letEnvironment :: Datum (Let -> Term)
letEnvironment = Name -> Name -> Datum (Let -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Let Name
_Let_environment

literalBinary :: Datum String -> Datum Literal
literalBinary :: Datum String -> Datum Literal
literalBinary = Name -> Name -> Datum String -> Datum Literal
forall a b. Name -> Name -> Datum a -> Datum b
variant Name
_Literal Name
_Literal_binary

literalBoolean :: Datum Bool -> Datum Literal
literalBoolean :: Datum Bool -> Datum Literal
literalBoolean = Name -> Name -> Datum Bool -> Datum Literal
forall a b. Name -> Name -> Datum a -> Datum b
variant Name
_Literal Name
_Literal_boolean

literalFloat :: Datum FloatValue -> Datum Literal
literalFloat :: Datum FloatValue -> Datum Literal
literalFloat = Name -> Name -> Datum FloatValue -> Datum Literal
forall a b. Name -> Name -> Datum a -> Datum b
variant Name
_Literal Name
_Literal_float

literalInteger :: Datum IntegerValue -> Datum Literal
literalInteger :: Datum IntegerValue -> Datum Literal
literalInteger = Name -> Name -> Datum IntegerValue -> Datum Literal
forall a b. Name -> Name -> Datum a -> Datum b
variant Name
_Literal Name
_Literal_integer

mapType :: Datum Type -> Datum Type -> Datum MapType
mapType :: Datum Type -> Datum Type -> Datum MapType
mapType Datum Type
keys Datum Type
values = Name -> [Field] -> Datum MapType
forall a. Name -> [Field] -> Datum a
Base.record Name
_MapType [
    Name
_MapType_keysName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
keys,
    Name
_MapType_valuesName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
values]

mapTypeKeys :: Datum (MapType -> Type)
mapTypeKeys :: Datum (MapType -> Type)
mapTypeKeys = Name -> Name -> Datum (MapType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_MapType Name
_MapType_keys

mapTypeValues :: Datum (MapType -> Type)
mapTypeValues :: Datum (MapType -> Type)
mapTypeValues = Name -> Name -> Datum (MapType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_MapType Name
_MapType_values

optionalCases :: Datum Term -> Datum Term -> Datum OptionalCases
optionalCases :: Datum Term -> Datum Term -> Datum OptionalCases
optionalCases Datum Term
nothing Datum Term
just = Name -> [Field] -> Datum OptionalCases
forall a. Name -> [Field] -> Datum a
Base.record Name
_OptionalCases [
    Name
_OptionalCases_nothingName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
nothing,
    Name
_OptionalCases_justName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
just]

optionalCasesNothing :: Datum (OptionalCases -> Term)
optionalCasesNothing :: Datum (OptionalCases -> Term)
optionalCasesNothing = Name -> Name -> Datum (OptionalCases -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_OptionalCases Name
_OptionalCases_nothing

optionalCasesJust :: Datum (OptionalCases -> Term)
optionalCasesJust :: Datum (OptionalCases -> Term)
optionalCasesJust = Name -> Name -> Datum (OptionalCases -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_OptionalCases Name
_OptionalCases_just

projectionTypeName :: Datum (Projection -> Name)
projectionTypeName :: Datum (Projection -> Name)
projectionTypeName = Name -> Name -> Datum (Projection -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Projection Name
_Projection_typeName

projectionField :: Datum (Projection -> Name)
projectionField :: Datum (Projection -> Name)
projectionField = Name -> Name -> Datum (Projection -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Projection Name
_Projection_field

record :: Datum Name -> Datum [Field] -> Datum Record
record :: Datum Name -> Datum [Field] -> Datum Record
record Datum Name
typeName Datum [Field]
fields = Name -> [Field] -> Datum Record
forall a. Name -> [Field] -> Datum a
Base.record Name
_Record [
    Name
_Record_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_Record_fieldsName -> Datum [Field] -> Field
forall a. Name -> Datum a -> Field
>>: Datum [Field]
fields]

recordTypeName :: Datum (Record -> Name)
recordTypeName :: Datum (Record -> Name)
recordTypeName = Name -> Name -> Datum (Record -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Record Name
_Record_typeName

recordFields :: Datum (Record -> [Field])
recordFields :: Datum (Record -> [Field])
recordFields = Name -> Name -> Datum (Record -> [Field])
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Record Name
_Record_fields

rowType :: Datum Name -> Datum (Maybe Name) -> Datum [FieldType] -> Datum (RowType)
rowType :: Datum Name
-> Datum (Maybe Name) -> Datum [FieldType] -> Datum RowType
rowType Datum Name
typeName Datum (Maybe Name)
extends Datum [FieldType]
fields = Name -> [Field] -> Datum RowType
forall a. Name -> [Field] -> Datum a
Base.record Name
_RowType [
    Name
_RowType_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_RowType_extendsName -> Datum (Maybe Name) -> Field
forall a. Name -> Datum a -> Field
>>: Datum (Maybe Name)
extends,
    Name
_RowType_fieldsName -> Datum [FieldType] -> Field
forall a. Name -> Datum a -> Field
>>: Datum [FieldType]
fields]

rowTypeTypeName :: Datum (RowType -> Name)
rowTypeTypeName :: Datum (RowType -> Name)
rowTypeTypeName = Name -> Name -> Datum (RowType -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_RowType Name
_RowType_typeName

rowTypeExtends :: Datum (RowType -> Maybe Name)
rowTypeExtends :: Datum (RowType -> Maybe Name)
rowTypeExtends = Name -> Name -> Datum (RowType -> Maybe Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_RowType Name
_RowType_extends

rowTypeFields :: Datum (RowType -> [FieldType])
rowTypeFields :: Datum (RowType -> [FieldType])
rowTypeFields = Name -> Name -> Datum (RowType -> [FieldType])
forall a b. Name -> Name -> Datum (a -> b)
project Name
_RowType Name
_RowType_fields

sum :: Datum Int -> Datum Int -> Datum Term -> Datum Sum
sum :: Datum Int -> Datum Int -> Datum Term -> Datum Sum
sum Datum Int
index Datum Int
size Datum Term
term = Name -> [Field] -> Datum Sum
forall a. Name -> [Field] -> Datum a
Base.record Name
_Sum [
    Name
_Sum_indexName -> Datum Int -> Field
forall a. Name -> Datum a -> Field
>>: Datum Int
index,
    Name
_Sum_sizeName -> Datum Int -> Field
forall a. Name -> Datum a -> Field
>>: Datum Int
size,
    Name
_Sum_termName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
term]

sumIndex :: Datum (Sum -> Int)
sumIndex :: Datum (Sum -> Int)
sumIndex = Name -> Name -> Datum (Sum -> Int)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Sum Name
_Sum_index

sumSize :: Datum (Sum -> Int)
sumSize :: Datum (Sum -> Int)
sumSize = Name -> Name -> Datum (Sum -> Int)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Sum Name
_Sum_size

sumTerm :: Datum (Sum -> Term)
sumTerm :: Datum (Sum -> Term)
sumTerm = Name -> Name -> Datum (Sum -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_Sum Name
_Sum_term

termAnnotated :: Datum AnnotatedTerm -> Datum Term
termAnnotated :: Datum AnnotatedTerm -> Datum Term
termAnnotated = Name -> Name -> Datum AnnotatedTerm -> Datum Term
forall a b. Name -> Name -> Datum a -> Datum b
variant Name
_Term Name
_Term_annotated

tupleProjectionArity :: Datum (TupleProjection -> Int)
tupleProjectionArity :: Datum (TupleProjection -> Int)
tupleProjectionArity = Name -> Name -> Datum (TupleProjection -> Int)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_TupleProjection Name
_TupleProjection_arity

tupleProjectionIndex :: Datum (TupleProjection -> Int)
tupleProjectionIndex :: Datum (TupleProjection -> Int)
tupleProjectionIndex = Name -> Name -> Datum (TupleProjection -> Int)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_TupleProjection Name
_TupleProjection_index

typeSchemeVariables :: Datum (TypeScheme -> [Name])
typeSchemeVariables :: Datum (TypeScheme -> [Name])
typeSchemeVariables = Name -> Name -> Datum (TypeScheme -> [Name])
forall a b. Name -> Name -> Datum (a -> b)
project Name
_TypeScheme Name
_TypeScheme_variables

typeSchemeType :: Datum (TypeScheme -> Type)
typeSchemeType :: Datum (TypeScheme -> Type)
typeSchemeType = Name -> Name -> Datum (TypeScheme -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_TypeScheme Name
_TypeScheme_type

typedTermTerm :: Datum (TypedTerm -> Term)
typedTermTerm :: Datum (TypedTerm -> Term)
typedTermTerm = Name -> Name -> Datum (TypedTerm -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_TypedTerm Name
_TypedTerm_term

wrappedTerm :: Datum Name -> Datum Term -> Datum WrappedTerm
wrappedTerm :: Datum Name -> Datum Term -> Datum WrappedTerm
wrappedTerm Datum Name
typeName Datum Term
object = Name -> [Field] -> Datum WrappedTerm
forall a. Name -> [Field] -> Datum a
Base.record Name
_WrappedTerm [
    Name
_WrappedTerm_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_WrappedTerm_objectName -> Datum Term -> Field
forall a. Name -> Datum a -> Field
>>: Datum Term
object]

wrappedTermTypeName :: Datum (WrappedTerm -> Name)
wrappedTermTypeName :: Datum (WrappedTerm -> Name)
wrappedTermTypeName = Name -> Name -> Datum (WrappedTerm -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_WrappedTerm Name
_WrappedTerm_typeName

wrappedTermObject :: Datum (WrappedTerm -> Term)
wrappedTermObject :: Datum (WrappedTerm -> Term)
wrappedTermObject = Name -> Name -> Datum (WrappedTerm -> Term)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_WrappedTerm Name
_WrappedTerm_object

wrappedType :: Datum Name -> Datum Type -> Datum WrappedType
wrappedType :: Datum Name -> Datum Type -> Datum WrappedType
wrappedType Datum Name
typeName Datum Type
object = Name -> [Field] -> Datum WrappedType
forall a. Name -> [Field] -> Datum a
Base.record Name
_WrappedType [
    Name
_WrappedType_typeNameName -> Datum Name -> Field
forall a. Name -> Datum a -> Field
>>: Datum Name
typeName,
    Name
_WrappedType_objectName -> Datum Type -> Field
forall a. Name -> Datum a -> Field
>>: Datum Type
object]

wrappedTypeTypeName :: Datum (WrappedType -> Name)
wrappedTypeTypeName :: Datum (WrappedType -> Name)
wrappedTypeTypeName = Name -> Name -> Datum (WrappedType -> Name)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_WrappedType Name
_WrappedType_typeName

wrappedTypeObject :: Datum (WrappedType -> Type)
wrappedTypeObject :: Datum (WrappedType -> Type)
wrappedTypeObject = Name -> Name -> Datum (WrappedType -> Type)
forall a b. Name -> Name -> Datum (a -> b)
project Name
_WrappedType Name
_WrappedType_object