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 subject annotation = Base.record _AnnotatedTerm [ _AnnotatedTerm_subject>>: subject, _AnnotatedTerm_annotation>>: annotation] annotatedTermSubject :: TTerm (AnnotatedTerm -> Term) annotatedTermSubject = project _AnnotatedTerm _AnnotatedTerm_subject annotatedTermAnnotation :: TTerm (AnnotatedTerm -> M.Map String Term) annotatedTermAnnotation = project _AnnotatedTerm _AnnotatedTerm_annotation annotatedType :: TTerm Type -> TTerm (M.Map String Term) -> TTerm AnnotatedType annotatedType subject annotation = Base.record _AnnotatedType [ _AnnotatedType_subject>>: subject, _AnnotatedType_annotation>>: annotation] annotatedTypeSubject :: TTerm (AnnotatedType -> Type) annotatedTypeSubject = project _AnnotatedType _AnnotatedType_subject annotatedTypeAnnotation :: TTerm (AnnotatedType -> M.Map String Term) annotatedTypeAnnotation = project _AnnotatedType _AnnotatedType_annotation application :: TTerm Term -> TTerm Term -> TTerm (Application) application function argument = Base.record _Application [ _Application_function>>: function, _Application_argument>>: argument] applicationFunction :: TTerm (Application -> Term) applicationFunction = project _Application _Application_function applicationArgument :: TTerm (Application -> Term) applicationArgument = project _Application _Application_argument applicationType :: TTerm Type -> TTerm Type -> TTerm (ApplicationType) applicationType function argument = Base.record _ApplicationType [ _ApplicationType_function>>: function, _ApplicationType_argument>>: argument] applicationTypeFunction :: TTerm (ApplicationType -> Type) applicationTypeFunction = project _ApplicationType _ApplicationType_function applicationTypeArgument :: TTerm (ApplicationType -> Type) applicationTypeArgument = project _ApplicationType _ApplicationType_argument caseStatement :: TTerm Name -> TTerm (Maybe Term) -> TTerm [Field] -> TTerm (CaseStatement) caseStatement typeName defaultTerm cases = Base.record _CaseStatement [ _CaseStatement_typeName>>: typeName, _CaseStatement_default>>: defaultTerm, _CaseStatement_cases>>: cases] caseStatementTypeName :: TTerm (CaseStatement -> Name) caseStatementTypeName = project _CaseStatement _CaseStatement_typeName caseStatementDefault :: TTerm (CaseStatement -> Maybe Term) caseStatementDefault = project _CaseStatement _CaseStatement_default caseStatementCases :: TTerm (CaseStatement -> [Field]) caseStatementCases = project _CaseStatement _CaseStatement_cases field :: TTerm Name -> TTerm Term -> TTerm Field field name term = Base.record _Field [ _Field_name>>: name, _Field_term>>: term] fieldName :: TTerm (Field -> Name) fieldName = project _Field _Field_name fieldTerm :: TTerm (Field -> Term) fieldTerm = project _Field _Field_term fieldType :: TTerm Name -> TTerm Type -> TTerm (FieldType) fieldType name typ = Base.record _FieldType [ _FieldType_name>>: name, _FieldType_type>>: typ] fieldTypeName :: TTerm (FieldType -> Name) fieldTypeName = project _FieldType _FieldType_name fieldTypeType :: TTerm (FieldType -> Type) fieldTypeType = project _FieldType _FieldType_type functionType :: TTerm Type -> TTerm Type -> TTerm (FunctionType) functionType domain codomain = Base.record _FunctionType [ _FunctionType_domain>>: domain, _FunctionType_codomain>>: codomain] functionTypeDomain :: TTerm (FunctionType -> Type) functionTypeDomain = project _FunctionType _FunctionType_domain functionTypeCodomain :: TTerm (FunctionType -> Type) functionTypeCodomain = project _FunctionType _FunctionType_codomain injection :: TTerm Name -> TTerm Field -> TTerm Injection injection typeName field = Base.record _Injection [ _Injection_typeName>>: typeName, _Injection_field>>: field] injectionTypeName :: TTerm (Injection -> Name) injectionTypeName = project _Injection _Injection_typeName injectionField :: TTerm (Injection -> Field) injectionField = project _Injection _Injection_field lambda :: TTerm Name -> TTerm Term -> TTerm Lambda lambda parameter body = Base.record _Lambda [ _Lambda_parameter>>: parameter, _Lambda_body>>: body] lambdaParameter :: TTerm (Lambda -> Name) lambdaParameter = project _Lambda _Lambda_parameter lambdaBody :: TTerm (Lambda -> Term) lambdaBody = project _Lambda _Lambda_body lambdaDomain :: TTerm (Lambda -> Maybe Type) lambdaDomain = project _Lambda _Lambda_domain lambdaType :: TTerm Name -> TTerm Type -> TTerm LambdaType lambdaType parameter body = Base.record _LambdaType [ _LambdaType_parameter>>: parameter, _LambdaType_body>>: body] lambdaTypeParameter :: TTerm (LambdaType -> Name) lambdaTypeParameter = project _LambdaType _LambdaType_parameter lambdaTypeBody :: TTerm (LambdaType -> Type) lambdaTypeBody = project _LambdaType _LambdaType_body letExpression :: TTerm [LetBinding] -> TTerm Term -> TTerm Let letExpression bindings environment = Base.record _Let [ _Let_bindings>>: bindings, _Let_environment>>: environment] letBindings :: TTerm (Let -> [LetBinding]) letBindings = project _Let _Let_bindings letBindingName :: TTerm (LetBinding -> Name) letBindingName = project _LetBinding _LetBinding_name letBindingTerm :: TTerm (LetBinding -> Term) letBindingTerm = project _LetBinding _LetBinding_term letBindingType :: TTerm (LetBinding -> Y.Maybe TypeScheme) letBindingType = project _LetBinding _LetBinding_type letEnvironment :: TTerm (Let -> Term) letEnvironment = project _Let _Let_environment literalBinary :: TTerm String -> TTerm Literal literalBinary = variant _Literal _Literal_binary literalBoolean :: TTerm Bool -> TTerm Literal literalBoolean = variant _Literal _Literal_boolean literalFloat :: TTerm FloatValue -> TTerm Literal literalFloat = variant _Literal _Literal_float literalInteger :: TTerm IntegerValue -> TTerm Literal literalInteger = variant _Literal _Literal_integer mapType :: TTerm Type -> TTerm Type -> TTerm MapType mapType keys values = Base.record _MapType [ _MapType_keys>>: keys, _MapType_values>>: values] mapTypeKeys :: TTerm (MapType -> Type) mapTypeKeys = project _MapType _MapType_keys mapTypeValues :: TTerm (MapType -> Type) mapTypeValues = project _MapType _MapType_values name :: Name -> TTerm Name name nm = TTerm $ coreEncodeName nm optionalCases :: TTerm Term -> TTerm Term -> TTerm OptionalCases optionalCases nothing just = Base.record _OptionalCases [ _OptionalCases_nothing>>: nothing, _OptionalCases_just>>: just] optionalCasesNothing :: TTerm (OptionalCases -> Term) optionalCasesNothing = project _OptionalCases _OptionalCases_nothing optionalCasesJust :: TTerm (OptionalCases -> Term) optionalCasesJust = project _OptionalCases _OptionalCases_just projectionTypeName :: TTerm (Projection -> Name) projectionTypeName = project _Projection _Projection_typeName projectionField :: TTerm (Projection -> Name) projectionField = project _Projection _Projection_field record :: TTerm Name -> TTerm [Field] -> TTerm Record record typeName fields = Base.record _Record [ _Record_typeName>>: typeName, _Record_fields>>: fields] recordTypeName :: TTerm (Record -> Name) recordTypeName = project _Record _Record_typeName recordFields :: TTerm (Record -> [Field]) recordFields = project _Record _Record_fields rowType :: TTerm Name -> TTerm [FieldType] -> TTerm (RowType) rowType typeName fields = Base.record _RowType [ _RowType_typeName>>: typeName, _RowType_fields>>: fields] rowTypeTypeName :: TTerm (RowType -> Name) rowTypeTypeName = project _RowType _RowType_typeName rowTypeFields :: TTerm (RowType -> [FieldType]) rowTypeFields = project _RowType _RowType_fields sum :: TTerm Int -> TTerm Int -> TTerm Term -> TTerm Sum sum index size term = Base.record _Sum [ _Sum_index>>: index, _Sum_size>>: size, _Sum_term>>: term] sumIndex :: TTerm (Sum -> Int) sumIndex = project _Sum _Sum_index sumSize :: TTerm (Sum -> Int) sumSize = project _Sum _Sum_size sumTerm :: TTerm (Sum -> Term) sumTerm = project _Sum _Sum_term termAnnotated :: TTerm AnnotatedTerm -> TTerm Term termAnnotated = variant _Term _Term_annotated tupleProjectionArity :: TTerm (TupleProjection -> Int) tupleProjectionArity = project _TupleProjection _TupleProjection_arity tupleProjectionIndex :: TTerm (TupleProjection -> Int) tupleProjectionIndex = project _TupleProjection _TupleProjection_index typeAbstractionParameter :: TTerm (TypeAbstraction -> Name) typeAbstractionParameter = project _TypeAbstraction _TypeAbstraction_parameter typeAbstractionBody :: TTerm (TypeAbstraction -> Type) typeAbstractionBody = project _TypeAbstraction _TypeAbstraction_body typeSchemeVariables :: TTerm (TypeScheme -> [Name]) typeSchemeVariables = project _TypeScheme _TypeScheme_variables typeSchemeType :: TTerm (TypeScheme -> Type) typeSchemeType = project _TypeScheme _TypeScheme_type typedTermTerm :: TTerm (TypedTerm -> Term) typedTermTerm = project _TypedTerm _TypedTerm_term unName :: TTerm (Name -> String) unName = unwrap _Name unNamespace :: TTerm (Namespace -> String) unNamespace = unwrap _Namespace wrappedTerm :: TTerm Name -> TTerm Term -> TTerm WrappedTerm wrappedTerm typeName object = Base.record _WrappedTerm [ _WrappedTerm_typeName>>: typeName, _WrappedTerm_object>>: object] wrappedTermTypeName :: TTerm (WrappedTerm -> Name) wrappedTermTypeName = project _WrappedTerm _WrappedTerm_typeName wrappedTermObject :: TTerm (WrappedTerm -> Term) wrappedTermObject = project _WrappedTerm _WrappedTerm_object wrappedType :: TTerm Name -> TTerm Type -> TTerm WrappedType wrappedType typeName object = Base.record _WrappedType [ _WrappedType_typeName>>: typeName, _WrappedType_object>>: object] wrappedTypeTypeName :: TTerm (WrappedType -> Name) wrappedTypeTypeName = project _WrappedType _WrappedType_typeName wrappedTypeObject :: TTerm (WrappedType -> Type) wrappedTypeObject = project _WrappedType _WrappedType_object