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 :: TTerm Term -> TTerm (M.Map String Term) -> TTerm AnnotatedTerm
annotatedTerm :: TTerm Term -> TTerm (Map String Term) -> TTerm AnnotatedTerm
annotatedTerm TTerm Term
subject TTerm (Map String Term)
annotation = Name -> [Field] -> TTerm AnnotatedTerm
forall a. Name -> [Field] -> TTerm a
Base.record Name
_AnnotatedTerm [
    Name
_AnnotatedTerm_subjectName -> TTerm Term -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm Term
subject,
    Name
_AnnotatedTerm_annotationName -> TTerm (Map String Term) -> Field
forall a. Name -> TTerm a -> Field
>>: TTerm (Map String Term)
annotation]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

lambdaDomain :: TTerm (Lambda -> Maybe Type)
lambdaDomain :: TTerm (Lambda -> Maybe Type)
lambdaDomain = Name -> Name -> TTerm (Lambda -> Maybe Type)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_Lambda Name
_Lambda_domain

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

name :: Name -> TTerm Name
name :: Name -> TTerm Name
name Name
nm = Term -> TTerm Name
forall a. Term -> TTerm a
TTerm (Term -> TTerm Name) -> Term -> TTerm Name
forall a b. (a -> b) -> a -> b
$ Name -> Term
coreEncodeName Name
nm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

typeAbstractionParameter :: TTerm (TypeAbstraction -> Name)
typeAbstractionParameter :: TTerm (TypeAbstraction -> Name)
typeAbstractionParameter = Name -> Name -> TTerm (TypeAbstraction -> Name)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_TypeAbstraction Name
_TypeAbstraction_parameter

typeAbstractionBody :: TTerm (TypeAbstraction -> Type)
typeAbstractionBody :: TTerm (TypeAbstraction -> Type)
typeAbstractionBody = Name -> Name -> TTerm (TypeAbstraction -> Type)
forall a b. Name -> Name -> TTerm (a -> b)
project Name
_TypeAbstraction Name
_TypeAbstraction_body

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

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

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

unName :: TTerm (Name -> String)
unName :: TTerm (Name -> String)
unName = Name -> TTerm (Name -> String)
forall a b. Name -> TTerm (a -> b)
unwrap Name
_Name

unNamespace :: TTerm (Namespace -> String)
unNamespace :: TTerm (Namespace -> String)
unNamespace = Name -> TTerm (Namespace -> String)
forall a b. Name -> TTerm (a -> b)
unwrap Name
_Namespace

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

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

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

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

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

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