hydra-kernel-0.18.0: src/main/haskell/Hydra/Core/Decode/Model.hs
-- Note: this is an automatically generated file. Do not edit.
-- | Term decoders for hydra.core.model
module Hydra.Core.Decode.Model where
import qualified Hydra.Core.Errors as Errors
import qualified Hydra.Core.Extract.Model as ExtractModel
import qualified Hydra.Core.Graph as Graph
import qualified Hydra.Core.Lexical as Lexical
import qualified Hydra.Core.Overlay.Haskell.Lib.Eithers as Eithers
import qualified Hydra.Core.Overlay.Haskell.Lib.Maps as Maps
import qualified Hydra.Core.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Core.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Core.Model as Model
import qualified Hydra.Core.Rewriting as Rewriting
import qualified Hydra.Core.Util as Util
import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, lines, map, pure, sum, unlines)
import qualified Data.Scientific as Sci
import Data.Void
-- | Decoder for hydra.core.model.AnnotatedTerm
annotatedTerm :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.AnnotatedTerm
annotatedTerm cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Eithers.bind (ExtractModel.requireField "annotation" term fieldMap cx) (\field_annotation -> Right (Model.AnnotatedTerm {
Model.annotatedTermBody = field_body,
Model.annotatedTermAnnotation = field_annotation}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.AnnotatedTerm")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.AnnotatedType
annotatedType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.AnnotatedType
annotatedType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "body" type_ fieldMap cx) (\field_body -> Eithers.bind (ExtractModel.requireField "annotation" term fieldMap cx) (\field_annotation -> Right (Model.AnnotatedType {
Model.annotatedTypeBody = field_body,
Model.annotatedTypeAnnotation = field_annotation}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.AnnotatedType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Application
application :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Application
application cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "function" term fieldMap cx) (\field_function -> Eithers.bind (ExtractModel.requireField "argument" term fieldMap cx) (\field_argument -> Right (Model.Application {
Model.applicationFunction = field_function,
Model.applicationArgument = field_argument}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Application")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.ApplicationType
applicationType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.ApplicationType
applicationType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "function" type_ fieldMap cx) (\field_function -> Eithers.bind (ExtractModel.requireField "argument" type_ fieldMap cx) (\field_argument -> Right (Model.ApplicationType {
Model.applicationTypeFunction = field_function,
Model.applicationTypeArgument = field_argument}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.ApplicationType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Binding
binding :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Binding
binding cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "name" name fieldMap cx) (\field_name -> Eithers.bind (ExtractModel.requireField "term" term fieldMap cx) (\field_term -> Eithers.bind (ExtractModel.requireField "typeScheme" (ExtractModel.decodeMaybe typeScheme) fieldMap cx) (\field_typeScheme -> Right (Model.Binding {
Model.bindingName = field_name,
Model.bindingTerm = field_term,
Model.bindingTypeScheme = field_typeScheme})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Binding")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.CaseAlternative
caseAlternative :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.CaseAlternative
caseAlternative cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "name" name fieldMap cx) (\field_name -> Eithers.bind (ExtractModel.requireField "handler" term fieldMap cx) (\field_handler -> Right (Model.CaseAlternative {
Model.caseAlternativeName = field_name,
Model.caseAlternativeHandler = field_handler}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.CaseAlternative")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.CaseStatement
caseStatement :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.CaseStatement
caseStatement cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "typeName" name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractModel.requireField "default" (ExtractModel.decodeMaybe term) fieldMap cx) (\field_default -> Eithers.bind (ExtractModel.requireField "cases" (ExtractModel.decodeList caseAlternative) fieldMap cx) (\field_cases -> Right (Model.CaseStatement {
Model.caseStatementTypeName = field_typeName,
Model.caseStatementDefault = field_default,
Model.caseStatementCases = field_cases})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.CaseStatement")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.EitherType
eitherType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.EitherType
eitherType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "left" type_ fieldMap cx) (\field_left -> Eithers.bind (ExtractModel.requireField "right" type_ fieldMap cx) (\field_right -> Right (Model.EitherType {
Model.eitherTypeLeft = field_left,
Model.eitherTypeRight = field_right}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.EitherType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Field
field :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Field
field cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "name" name fieldMap cx) (\field_name -> Eithers.bind (ExtractModel.requireField "term" term fieldMap cx) (\field_term -> Right (Model.Field {
Model.fieldName = field_name,
Model.fieldTerm = field_term}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Field")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.FieldType
fieldType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.FieldType
fieldType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "name" name fieldMap cx) (\field_name -> Eithers.bind (ExtractModel.requireField "type" type_ fieldMap cx) (\field_type -> Right (Model.FieldType {
Model.fieldTypeName = field_name,
Model.fieldTypeType = field_type}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.FieldType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.FloatType
floatType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.FloatType
floatType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "float32", (\input -> Eithers.map (\t -> Model.FloatTypeFloat32) (ExtractModel.decodeUnit cx input))),
(Model.Name "float64", (\input -> Eithers.map (\t -> Model.FloatTypeFloat64) (ExtractModel.decodeUnit cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.FloatValue
floatValue :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.FloatValue
floatValue cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(
Model.Name "float32",
(\input -> Eithers.map (\t -> Model.FloatValueFloat32 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralFloat v2 -> case v2 of
Model.FloatValueFloat32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected float32 value")
_ -> Left (Errors.DecodingError "expected float32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "float64",
(\input -> Eithers.map (\t -> Model.FloatValueFloat64 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralFloat v2 -> case v2 of
Model.FloatValueFloat64 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected float64 value")
_ -> Left (Errors.DecodingError "expected float64 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input))))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.ForallType
forallType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.ForallType
forallType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "parameter" name fieldMap cx) (\field_parameter -> Eithers.bind (ExtractModel.requireField "body" type_ fieldMap cx) (\field_body -> Right (Model.ForallType {
Model.forallTypeParameter = field_parameter,
Model.forallTypeBody = field_body}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.ForallType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.FunctionType
functionType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.FunctionType
functionType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "domain" type_ fieldMap cx) (\field_domain -> Eithers.bind (ExtractModel.requireField "codomain" type_ fieldMap cx) (\field_codomain -> Right (Model.FunctionType {
Model.functionTypeDomain = field_domain,
Model.functionTypeCodomain = field_codomain}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.FunctionType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Injection
injection :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Injection
injection cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "typeName" name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractModel.requireField "field" field fieldMap cx) (\field_field -> Right (Model.Injection {
Model.injectionTypeName = field_typeName,
Model.injectionField = field_field}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Injection")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.IntegerType
integerType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.IntegerType
integerType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "bigint", (\input -> Eithers.map (\t -> Model.IntegerTypeBigint) (ExtractModel.decodeUnit cx input))),
(Model.Name "int8", (\input -> Eithers.map (\t -> Model.IntegerTypeInt8) (ExtractModel.decodeUnit cx input))),
(Model.Name "int16", (\input -> Eithers.map (\t -> Model.IntegerTypeInt16) (ExtractModel.decodeUnit cx input))),
(Model.Name "int32", (\input -> Eithers.map (\t -> Model.IntegerTypeInt32) (ExtractModel.decodeUnit cx input))),
(Model.Name "int64", (\input -> Eithers.map (\t -> Model.IntegerTypeInt64) (ExtractModel.decodeUnit cx input))),
(Model.Name "uint8", (\input -> Eithers.map (\t -> Model.IntegerTypeUint8) (ExtractModel.decodeUnit cx input))),
(Model.Name "uint16", (\input -> Eithers.map (\t -> Model.IntegerTypeUint16) (ExtractModel.decodeUnit cx input))),
(Model.Name "uint32", (\input -> Eithers.map (\t -> Model.IntegerTypeUint32) (ExtractModel.decodeUnit cx input))),
(Model.Name "uint64", (\input -> Eithers.map (\t -> Model.IntegerTypeUint64) (ExtractModel.decodeUnit cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.IntegerValue
integerValue :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.IntegerValue
integerValue cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(
Model.Name "bigint",
(\input -> Eithers.map (\t -> Model.IntegerValueBigint t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueBigint v3 -> Right v3
_ -> Left (Errors.DecodingError "expected bigint value")
_ -> Left (Errors.DecodingError "expected bigint literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "int8",
(\input -> Eithers.map (\t -> Model.IntegerValueInt8 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueInt8 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int8 value")
_ -> Left (Errors.DecodingError "expected int8 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "int16",
(\input -> Eithers.map (\t -> Model.IntegerValueInt16 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueInt16 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int16 value")
_ -> Left (Errors.DecodingError "expected int16 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "int32",
(\input -> Eithers.map (\t -> Model.IntegerValueInt32 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueInt32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int32 value")
_ -> Left (Errors.DecodingError "expected int32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "int64",
(\input -> Eithers.map (\t -> Model.IntegerValueInt64 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueInt64 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int64 value")
_ -> Left (Errors.DecodingError "expected int64 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "uint8",
(\input -> Eithers.map (\t -> Model.IntegerValueUint8 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueUint8 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected uint8 value")
_ -> Left (Errors.DecodingError "expected uint8 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "uint16",
(\input -> Eithers.map (\t -> Model.IntegerValueUint16 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueUint16 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected uint16 value")
_ -> Left (Errors.DecodingError "expected uint16 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "uint32",
(\input -> Eithers.map (\t -> Model.IntegerValueUint32 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueUint32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected uint32 value")
_ -> Left (Errors.DecodingError "expected uint32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "uint64",
(\input -> Eithers.map (\t -> Model.IntegerValueUint64 t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralInteger v2 -> case v2 of
Model.IntegerValueUint64 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected uint64 value")
_ -> Left (Errors.DecodingError "expected uint64 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input))))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Lambda
lambda :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Lambda
lambda cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "parameter" name fieldMap cx) (\field_parameter -> Eithers.bind (ExtractModel.requireField "domain" (ExtractModel.decodeMaybe type_) fieldMap cx) (\field_domain -> Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Right (Model.Lambda {
Model.lambdaParameter = field_parameter,
Model.lambdaDomain = field_domain,
Model.lambdaBody = field_body})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Lambda")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Let
let_ :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Let
let_ cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "bindings" (ExtractModel.decodeList binding) fieldMap cx) (\field_bindings -> Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Right (Model.Let {
Model.letBindings = field_bindings,
Model.letBody = field_body}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Let")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Literal
literal :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Literal
literal cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(
Model.Name "binary",
(\input -> Eithers.map (\t -> Model.LiteralBinary t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralBinary v2 -> Right v2
_ -> Left (Errors.DecodingError "expected binary literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "boolean",
(\input -> Eithers.map (\t -> Model.LiteralBoolean t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralBoolean v2 -> Right v2
_ -> Left (Errors.DecodingError "expected boolean literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(
Model.Name "decimal",
(\input -> Eithers.map (\t -> Model.LiteralDecimal t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralDecimal v2 -> Right v2
_ -> Left (Errors.DecodingError "expected decimal literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input)))),
(Model.Name "float", (\input -> Eithers.map (\t -> Model.LiteralFloat t) (floatValue cx input))),
(Model.Name "integer", (\input -> Eithers.map (\t -> Model.LiteralInteger t) (integerValue cx input))),
(
Model.Name "string",
(\input -> Eithers.map (\t -> Model.LiteralString t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralString v2 -> Right v2
_ -> Left (Errors.DecodingError "expected string literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx input))))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.LiteralType
literalType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.LiteralType
literalType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "binary", (\input -> Eithers.map (\t -> Model.LiteralTypeBinary) (ExtractModel.decodeUnit cx input))),
(Model.Name "boolean", (\input -> Eithers.map (\t -> Model.LiteralTypeBoolean) (ExtractModel.decodeUnit cx input))),
(Model.Name "decimal", (\input -> Eithers.map (\t -> Model.LiteralTypeDecimal) (ExtractModel.decodeUnit cx input))),
(Model.Name "float", (\input -> Eithers.map (\t -> Model.LiteralTypeFloat t) (floatType cx input))),
(Model.Name "integer", (\input -> Eithers.map (\t -> Model.LiteralTypeInteger t) (integerType cx input))),
(Model.Name "string", (\input -> Eithers.map (\t -> Model.LiteralTypeString) (ExtractModel.decodeUnit cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.MapType
mapType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.MapType
mapType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "keys" type_ fieldMap cx) (\field_keys -> Eithers.bind (ExtractModel.requireField "values" type_ fieldMap cx) (\field_values -> Right (Model.MapType {
Model.mapTypeKeys = field_keys,
Model.mapTypeValues = field_values}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.MapType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Name
name :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Name
name cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermWrap v0 -> Eithers.map (\b -> Model.Name b) ((\raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Model.TermLiteral v1 -> case v1 of
Model.LiteralString v2 -> Right v2
_ -> Left (Errors.DecodingError "expected string literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractModel.stripWithDecodingError cx raw2)) (Model.wrappedTermBody v0))
_ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.PairType
pairType :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.PairType
pairType cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "first" type_ fieldMap cx) (\field_first -> Eithers.bind (ExtractModel.requireField "second" type_ fieldMap cx) (\field_second -> Right (Model.PairType {
Model.pairTypeFirst = field_first,
Model.pairTypeSecond = field_second}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.PairType")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Projection
projection :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Projection
projection cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "typeName" name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractModel.requireField "fieldName" name fieldMap cx) (\field_fieldName -> Right (Model.Projection {
Model.projectionTypeName = field_typeName,
Model.projectionFieldName = field_fieldName}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Projection")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Record
record :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Record
record cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "typeName" name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractModel.requireField "fields" (ExtractModel.decodeList field) fieldMap cx) (\field_fields -> Right (Model.Record {
Model.recordTypeName = field_typeName,
Model.recordFields = field_fields}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.Record")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Term
term :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Term
term cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "annotated", (\input -> Eithers.map (\t -> Model.TermAnnotated t) (annotatedTerm cx input))),
(Model.Name "application", (\input -> Eithers.map (\t -> Model.TermApplication t) (application cx input))),
(Model.Name "cases", (\input -> Eithers.map (\t -> Model.TermCases t) (caseStatement cx input))),
(Model.Name "either", (\input -> Eithers.map (\t -> Model.TermEither t) (ExtractModel.decodeEither term term cx input))),
(Model.Name "inject", (\input -> Eithers.map (\t -> Model.TermInject t) (injection cx input))),
(Model.Name "lambda", (\input -> Eithers.map (\t -> Model.TermLambda t) (lambda cx input))),
(Model.Name "let", (\input -> Eithers.map (\t -> Model.TermLet t) (let_ cx input))),
(Model.Name "list", (\input -> Eithers.map (\t -> Model.TermList t) (ExtractModel.decodeList term cx input))),
(Model.Name "literal", (\input -> Eithers.map (\t -> Model.TermLiteral t) (literal cx input))),
(Model.Name "map", (\input -> Eithers.map (\t -> Model.TermMap t) (ExtractModel.decodeMap term term cx input))),
(Model.Name "optional", (\input -> Eithers.map (\t -> Model.TermOptional t) (ExtractModel.decodeMaybe term cx input))),
(Model.Name "pair", (\input -> Eithers.map (\t -> Model.TermPair t) (ExtractModel.decodePair term term cx input))),
(Model.Name "project", (\input -> Eithers.map (\t -> Model.TermProject t) (projection cx input))),
(Model.Name "record", (\input -> Eithers.map (\t -> Model.TermRecord t) (record cx input))),
(Model.Name "set", (\input -> Eithers.map (\t -> Model.TermSet t) (ExtractModel.decodeSet term cx input))),
(Model.Name "typeApplication", (\input -> Eithers.map (\t -> Model.TermTypeApplication t) (typeApplicationTerm cx input))),
(Model.Name "typeLambda", (\input -> Eithers.map (\t -> Model.TermTypeLambda t) (typeLambda cx input))),
(Model.Name "unit", (\input -> Eithers.map (\t -> Model.TermUnit) (ExtractModel.decodeUnit cx input))),
(Model.Name "unwrap", (\input -> Eithers.map (\t -> Model.TermUnwrap t) (name cx input))),
(Model.Name "variable", (\input -> Eithers.map (\t -> Model.TermVariable t) (name cx input))),
(Model.Name "wrap", (\input -> Eithers.map (\t -> Model.TermWrap t) (wrappedTerm cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.Type
type_ :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.Type
type_ cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "annotated", (\input -> Eithers.map (\t -> Model.TypeAnnotated t) (annotatedType cx input))),
(Model.Name "application", (\input -> Eithers.map (\t -> Model.TypeApplication t) (applicationType cx input))),
(Model.Name "effect", (\input -> Eithers.map (\t -> Model.TypeEffect t) (type_ cx input))),
(Model.Name "either", (\input -> Eithers.map (\t -> Model.TypeEither t) (eitherType cx input))),
(Model.Name "forall", (\input -> Eithers.map (\t -> Model.TypeForall t) (forallType cx input))),
(Model.Name "function", (\input -> Eithers.map (\t -> Model.TypeFunction t) (functionType cx input))),
(Model.Name "list", (\input -> Eithers.map (\t -> Model.TypeList t) (type_ cx input))),
(Model.Name "literal", (\input -> Eithers.map (\t -> Model.TypeLiteral t) (literalType cx input))),
(Model.Name "map", (\input -> Eithers.map (\t -> Model.TypeMap t) (mapType cx input))),
(Model.Name "optional", (\input -> Eithers.map (\t -> Model.TypeOptional t) (type_ cx input))),
(Model.Name "pair", (\input -> Eithers.map (\t -> Model.TypePair t) (pairType cx input))),
(Model.Name "record", (\input -> Eithers.map (\t -> Model.TypeRecord t) (ExtractModel.decodeList fieldType cx input))),
(Model.Name "set", (\input -> Eithers.map (\t -> Model.TypeSet t) (type_ cx input))),
(Model.Name "union", (\input -> Eithers.map (\t -> Model.TypeUnion t) (ExtractModel.decodeList fieldType cx input))),
(Model.Name "unit", (\input -> Eithers.map (\t -> Model.TypeUnit) (ExtractModel.decodeUnit cx input))),
(Model.Name "variable", (\input -> Eithers.map (\t -> Model.TypeVariable t) (name cx input))),
(Model.Name "void", (\input -> Eithers.map (\t -> Model.TypeVoid) (ExtractModel.decodeUnit cx input))),
(Model.Name "wrap", (\input -> Eithers.map (\t -> Model.TypeWrap t) (type_ cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.TypeApplicationTerm
typeApplicationTerm :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.TypeApplicationTerm
typeApplicationTerm cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Eithers.bind (ExtractModel.requireField "type" type_ fieldMap cx) (\field_type -> Right (Model.TypeApplicationTerm {
Model.typeApplicationTermBody = field_body,
Model.typeApplicationTermType = field_type}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.TypeApplicationTerm")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.TypeClassConstraint
typeClassConstraint :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.TypeClassConstraint
typeClassConstraint cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermInject v0 ->
let field = Model.injectionField v0
fname = Model.fieldName field
fterm = Model.fieldTerm field
variantMap =
Maps.fromList [
(Model.Name "simple", (\input -> Eithers.map (\t -> Model.TypeClassConstraintSimple t) (name cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Model.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.TypeLambda
typeLambda :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.TypeLambda
typeLambda cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "parameter" name fieldMap cx) (\field_parameter -> Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Right (Model.TypeLambda {
Model.typeLambdaParameter = field_parameter,
Model.typeLambdaBody = field_body}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.TypeLambda")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.TypeScheme
typeScheme :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.TypeScheme
typeScheme cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "variables" (ExtractModel.decodeList name) fieldMap cx) (\field_variables -> Eithers.bind (ExtractModel.requireField "body" type_ fieldMap cx) (\field_body -> Eithers.bind (ExtractModel.requireField "constraints" (ExtractModel.decodeMap name typeVariableConstraints) fieldMap cx) (\field_constraints -> Right (Model.TypeScheme {
Model.typeSchemeVariables = field_variables,
Model.typeSchemeBody = field_body,
Model.typeSchemeConstraints = field_constraints})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.TypeScheme")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.TypeVariableConstraints
typeVariableConstraints :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.TypeVariableConstraints
typeVariableConstraints cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "classes" (ExtractModel.decodeSet typeClassConstraint) fieldMap cx) (\field_classes -> Right (Model.TypeVariableConstraints {
Model.typeVariableConstraintsClasses = field_classes})))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.TypeVariableConstraints")) (ExtractModel.stripWithDecodingError cx raw)
-- | Decoder for hydra.core.model.WrappedTerm
wrappedTerm :: Graph.Graph -> Model.Term -> Either Errors.DecodingError Model.WrappedTerm
wrappedTerm cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Model.TermRecord v0 ->
let fieldMap = ExtractModel.toFieldMap v0
in (Eithers.bind (ExtractModel.requireField "typeName" name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractModel.requireField "body" term fieldMap cx) (\field_body -> Right (Model.WrappedTerm {
Model.wrappedTermTypeName = field_typeName,
Model.wrappedTermBody = field_body}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.core.model.WrappedTerm")) (ExtractModel.stripWithDecodingError cx raw)