hydra-kernel-0.17.7: src/main/haskell/Hydra/Decode/Paths.hs
-- Note: this is an automatically generated file. Do not edit.
-- | Term decoders for hydra.paths
module Hydra.Decode.Paths where
import qualified Hydra.Core as Core
import qualified Hydra.Decode.Core as DecodeCore
import qualified Hydra.Errors as Errors
import qualified Hydra.Extract.Core as ExtractCore
import qualified Hydra.Graph as Graph
import qualified Hydra.Lexical as Lexical
import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers
import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Paths as Paths
import qualified Hydra.Rewriting as Rewriting
import qualified Hydra.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.paths.LambdaVariableReference
lambdaVariableReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.LambdaVariableReference
lambdaVariableReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "variable" DecodeCore.name fieldMap cx) (\field_variable -> Eithers.bind (ExtractCore.requireField "boundByNode" termNodeId fieldMap cx) (\field_boundByNode -> Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Right (Paths.LambdaVariableReference {
Paths.lambdaVariableReferenceVariable = field_variable,
Paths.lambdaVariableReferenceBoundByNode = field_boundByNode,
Paths.lambdaVariableReferenceType = field_type})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.LambdaVariableReference")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.LetVariableReference
letVariableReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.LetVariableReference
letVariableReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "variable" DecodeCore.name fieldMap cx) (\field_variable -> Eithers.bind (ExtractCore.requireField "bindingNode" termNodeId fieldMap cx) (\field_bindingNode -> Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Right (Paths.LetVariableReference {
Paths.letVariableReferenceVariable = field_variable,
Paths.letVariableReferenceBindingNode = field_bindingNode,
Paths.letVariableReferenceType = field_type})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.LetVariableReference")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.NominalTypeReference
nominalTypeReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.NominalTypeReference
nominalTypeReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Right (Paths.NominalTypeReference {
Paths.nominalTypeReferenceName = field_name})))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.NominalTypeReference")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.PrimitiveReference
primitiveReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.PrimitiveReference
primitiveReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Right (Paths.PrimitiveReference {
Paths.primitiveReferenceName = field_name,
Paths.primitiveReferenceType = field_type}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.PrimitiveReference")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtermLink
subtermLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermLink
subtermLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "step" subtermStep fieldMap cx) (\field_step -> Eithers.bind (ExtractCore.requireField "child" termNode fieldMap cx) (\field_child -> Right (Paths.SubtermLink {
Paths.subtermLinkStep = field_step,
Paths.subtermLinkChild = field_child}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtermLink")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtermPath
subtermPath :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermPath
subtermPath cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermWrap v0 -> Eithers.map (\b -> Paths.SubtermPath b) (ExtractCore.decodeList subtermStep cx (Core.wrappedTermBody v0))
_ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtermStep
subtermStep :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermStep
subtermStep cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(
Core.Name "annotatedAnnotation",
(\input -> Eithers.map (\t -> Paths.SubtermStepAnnotatedAnnotation) (ExtractCore.decodeUnit cx input))),
(
Core.Name "annotatedBody",
(\input -> Eithers.map (\t -> Paths.SubtermStepAnnotatedBody) (ExtractCore.decodeUnit cx input))),
(
Core.Name "applicationArgument",
(\input -> Eithers.map (\t -> Paths.SubtermStepApplicationArgument) (ExtractCore.decodeUnit cx input))),
(
Core.Name "applicationFunction",
(\input -> Eithers.map (\t -> Paths.SubtermStepApplicationFunction) (ExtractCore.decodeUnit cx input))),
(Core.Name "casesCase", (\input -> Eithers.map (\t -> Paths.SubtermStepCasesCase t) (DecodeCore.name cx input))),
(
Core.Name "casesDefault",
(\input -> Eithers.map (\t -> Paths.SubtermStepCasesDefault) (ExtractCore.decodeUnit cx input))),
(Core.Name "eitherLeft", (\input -> Eithers.map (\t -> Paths.SubtermStepEitherLeft) (ExtractCore.decodeUnit cx input))),
(Core.Name "eitherRight", (\input -> Eithers.map (\t -> Paths.SubtermStepEitherRight) (ExtractCore.decodeUnit cx input))),
(Core.Name "injectField", (\input -> Eithers.map (\t -> Paths.SubtermStepInjectField t) (DecodeCore.name cx input))),
(Core.Name "lambdaBody", (\input -> Eithers.map (\t -> Paths.SubtermStepLambdaBody) (ExtractCore.decodeUnit cx input))),
(Core.Name "letBinding", (\input -> Eithers.map (\t -> Paths.SubtermStepLetBinding t) (DecodeCore.name cx input))),
(Core.Name "letBody", (\input -> Eithers.map (\t -> Paths.SubtermStepLetBody) (ExtractCore.decodeUnit cx input))),
(
Core.Name "listElement",
(\input -> Eithers.map (\t -> Paths.SubtermStepListElement t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Core.TermLiteral v1 -> case v1 of
Core.LiteralInteger v2 -> case v2 of
Core.IntegerValueInt32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int32 value")
_ -> Left (Errors.DecodingError "expected int32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))),
(
Core.Name "mapEntry",
(\input -> Eithers.map (\t -> Paths.SubtermStepMapEntry t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Core.TermLiteral v1 -> case v1 of
Core.LiteralInteger v2 -> case v2 of
Core.IntegerValueInt32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int32 value")
_ -> Left (Errors.DecodingError "expected int32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))),
(
Core.Name "optionalGiven",
(\input -> Eithers.map (\t -> Paths.SubtermStepOptionalGiven) (ExtractCore.decodeUnit cx input))),
(Core.Name "pairFirst", (\input -> Eithers.map (\t -> Paths.SubtermStepPairFirst) (ExtractCore.decodeUnit cx input))),
(Core.Name "pairSecond", (\input -> Eithers.map (\t -> Paths.SubtermStepPairSecond) (ExtractCore.decodeUnit cx input))),
(Core.Name "recordField", (\input -> Eithers.map (\t -> Paths.SubtermStepRecordField t) (DecodeCore.name cx input))),
(
Core.Name "setElement",
(\input -> Eithers.map (\t -> Paths.SubtermStepSetElement t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of
Core.TermLiteral v1 -> case v1 of
Core.LiteralInteger v2 -> case v2 of
Core.IntegerValueInt32 v3 -> Right v3
_ -> Left (Errors.DecodingError "expected int32 value")
_ -> Left (Errors.DecodingError "expected int32 literal")
_ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))),
(
Core.Name "typeApplicationBody",
(\input -> Eithers.map (\t -> Paths.SubtermStepTypeApplicationBody) (ExtractCore.decodeUnit cx input))),
(
Core.Name "typeLambdaBody",
(\input -> Eithers.map (\t -> Paths.SubtermStepTypeLambdaBody) (ExtractCore.decodeUnit cx input))),
(Core.Name "wrapBody", (\input -> Eithers.map (\t -> Paths.SubtermStepWrapBody) (ExtractCore.decodeUnit cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtypeLink
subtypeLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeLink
subtypeLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "step" subtypeStep fieldMap cx) (\field_step -> Eithers.bind (ExtractCore.requireField "child" typeNode fieldMap cx) (\field_child -> Right (Paths.SubtypeLink {
Paths.subtypeLinkStep = field_step,
Paths.subtypeLinkChild = field_child}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtypeLink")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtypePath
subtypePath :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypePath
subtypePath cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermWrap v0 -> Eithers.map (\b -> Paths.SubtypePath b) (ExtractCore.decodeList subtypeStep cx (Core.wrappedTermBody v0))
_ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.SubtypeStep
subtypeStep :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeStep
subtypeStep cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(
Core.Name "annotatedBody",
(\input -> Eithers.map (\t -> Paths.SubtypeStepAnnotatedBody) (ExtractCore.decodeUnit cx input))),
(
Core.Name "applicationArgument",
(\input -> Eithers.map (\t -> Paths.SubtypeStepApplicationArgument) (ExtractCore.decodeUnit cx input))),
(
Core.Name "applicationFunction",
(\input -> Eithers.map (\t -> Paths.SubtypeStepApplicationFunction) (ExtractCore.decodeUnit cx input))),
(Core.Name "effectValue", (\input -> Eithers.map (\t -> Paths.SubtypeStepEffectValue) (ExtractCore.decodeUnit cx input))),
(Core.Name "eitherLeft", (\input -> Eithers.map (\t -> Paths.SubtypeStepEitherLeft) (ExtractCore.decodeUnit cx input))),
(Core.Name "eitherRight", (\input -> Eithers.map (\t -> Paths.SubtypeStepEitherRight) (ExtractCore.decodeUnit cx input))),
(Core.Name "forallBody", (\input -> Eithers.map (\t -> Paths.SubtypeStepForallBody) (ExtractCore.decodeUnit cx input))),
(
Core.Name "functionCodomain",
(\input -> Eithers.map (\t -> Paths.SubtypeStepFunctionCodomain) (ExtractCore.decodeUnit cx input))),
(
Core.Name "functionDomain",
(\input -> Eithers.map (\t -> Paths.SubtypeStepFunctionDomain) (ExtractCore.decodeUnit cx input))),
(Core.Name "listElement", (\input -> Eithers.map (\t -> Paths.SubtypeStepListElement) (ExtractCore.decodeUnit cx input))),
(Core.Name "mapKeys", (\input -> Eithers.map (\t -> Paths.SubtypeStepMapKeys) (ExtractCore.decodeUnit cx input))),
(Core.Name "mapValues", (\input -> Eithers.map (\t -> Paths.SubtypeStepMapValues) (ExtractCore.decodeUnit cx input))),
(
Core.Name "optionalElement",
(\input -> Eithers.map (\t -> Paths.SubtypeStepOptionalElement) (ExtractCore.decodeUnit cx input))),
(Core.Name "pairFirst", (\input -> Eithers.map (\t -> Paths.SubtypeStepPairFirst) (ExtractCore.decodeUnit cx input))),
(Core.Name "pairSecond", (\input -> Eithers.map (\t -> Paths.SubtypeStepPairSecond) (ExtractCore.decodeUnit cx input))),
(Core.Name "recordField", (\input -> Eithers.map (\t -> Paths.SubtypeStepRecordField t) (DecodeCore.name cx input))),
(Core.Name "setElement", (\input -> Eithers.map (\t -> Paths.SubtypeStepSetElement) (ExtractCore.decodeUnit cx input))),
(Core.Name "unionField", (\input -> Eithers.map (\t -> Paths.SubtypeStepUnionField t) (DecodeCore.name cx input))),
(Core.Name "wrapBody", (\input -> Eithers.map (\t -> Paths.SubtypeStepWrapBody) (ExtractCore.decodeUnit cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermAttributeLink
termAttributeLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermAttributeLink
termAttributeLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(
Core.Name "casesTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkCasesTypeName t) (DecodeCore.name cx input))),
(
Core.Name "injectTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkInjectTypeName t) (DecodeCore.name cx input))),
(
Core.Name "lambdaDomainGiven",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkLambdaDomainGiven t) (DecodeCore.type_ cx input))),
(
Core.Name "lambdaParameter",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkLambdaParameter t) (DecodeCore.name cx input))),
(
Core.Name "letBindingTypeSchemeGiven",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkLetBindingTypeSchemeGiven t) (ExtractCore.decodePair DecodeCore.name DecodeCore.typeScheme cx input))),
(Core.Name "literal", (\input -> Eithers.map (\t -> Paths.TermAttributeLinkLiteral t) (DecodeCore.literal cx input))),
(
Core.Name "projectFieldName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkProjectFieldName t) (DecodeCore.name cx input))),
(
Core.Name "projectTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkProjectTypeName t) (DecodeCore.name cx input))),
(
Core.Name "recordTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkRecordTypeName t) (DecodeCore.name cx input))),
(
Core.Name "typeApplicationType",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkTypeApplicationType t) (DecodeCore.type_ cx input))),
(
Core.Name "typeLambdaParameter",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkTypeLambdaParameter t) (DecodeCore.name cx input))),
(
Core.Name "unwrapTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkUnwrapTypeName t) (DecodeCore.name cx input))),
(
Core.Name "wrapTypeName",
(\input -> Eithers.map (\t -> Paths.TermAttributeLinkWrapTypeName t) (DecodeCore.name cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermGraph
termGraph :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermGraph
termGraph cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "roots" (ExtractCore.decodeMap DecodeCore.name termNode) fieldMap cx) (\field_roots -> Right (Paths.TermGraph {
Paths.termGraphRoots = field_roots})))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TermGraph")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermLink
termLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermLink
termLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(Core.Name "attribute", (\input -> Eithers.map (\t -> Paths.TermLinkAttribute t) (termAttributeLink cx input))),
(Core.Name "reference", (\input -> Eithers.map (\t -> Paths.TermLinkReference t) (termReferenceLink cx input))),
(Core.Name "subterm", (\input -> Eithers.map (\t -> Paths.TermLinkSubterm t) (subtermLink cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermNode
termNode :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermNode
termNode cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "term" DecodeCore.term fieldMap cx) (\field_term -> Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Eithers.bind (ExtractCore.requireField "links" (ExtractCore.decodeList termLink) fieldMap cx) (\field_links -> Right (Paths.TermNode {
Paths.termNodeTerm = field_term,
Paths.termNodeType = field_type,
Paths.termNodeLinks = field_links})))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TermNode")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermNodeId
termNodeId :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermNodeId
termNodeId cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "root" DecodeCore.name fieldMap cx) (\field_root -> Eithers.bind (ExtractCore.requireField "path" subtermPath fieldMap cx) (\field_path -> Right (Paths.TermNodeId {
Paths.termNodeIdRoot = field_root,
Paths.termNodeIdPath = field_path}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TermNodeId")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermReference
termReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermReference
termReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(Core.Name "lambda", (\input -> Eithers.map (\t -> Paths.TermReferenceLambda t) (lambdaVariableReference cx input))),
(Core.Name "let", (\input -> Eithers.map (\t -> Paths.TermReferenceLet t) (letVariableReference cx input))),
(Core.Name "primitive", (\input -> Eithers.map (\t -> Paths.TermReferencePrimitive t) (primitiveReference cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TermReferenceLink
termReferenceLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TermReferenceLink
termReferenceLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "step" subtermStep fieldMap cx) (\field_step -> Eithers.bind (ExtractCore.requireField "target" termReference fieldMap cx) (\field_target -> Right (Paths.TermReferenceLink {
Paths.termReferenceLinkStep = field_step,
Paths.termReferenceLinkTarget = field_target}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TermReferenceLink")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeAttributeLink
typeAttributeLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeAttributeLink
typeAttributeLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(
Core.Name "annotatedAnnotation",
(\input -> Eithers.map (\t -> Paths.TypeAttributeLinkAnnotatedAnnotation t) (DecodeCore.term cx input))),
(
Core.Name "forallParameter",
(\input -> Eithers.map (\t -> Paths.TypeAttributeLinkForallParameter t) (DecodeCore.name cx input))),
(Core.Name "literal", (\input -> Eithers.map (\t -> Paths.TypeAttributeLinkLiteral t) (DecodeCore.literalType cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeGraph
typeGraph :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeGraph
typeGraph cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "roots" (ExtractCore.decodeMap DecodeCore.name typeNode) fieldMap cx) (\field_roots -> Right (Paths.TypeGraph {
Paths.typeGraphRoots = field_roots})))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TypeGraph")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeLink
typeLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeLink
typeLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(Core.Name "attribute", (\input -> Eithers.map (\t -> Paths.TypeLinkAttribute t) (typeAttributeLink cx input))),
(Core.Name "reference", (\input -> Eithers.map (\t -> Paths.TypeLinkReference t) (typeReferenceLink cx input))),
(Core.Name "subtype", (\input -> Eithers.map (\t -> Paths.TypeLinkSubtype t) (subtypeLink cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeNode
typeNode :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeNode
typeNode cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Eithers.bind (ExtractCore.requireField "links" (ExtractCore.decodeList typeLink) fieldMap cx) (\field_links -> Right (Paths.TypeNode {
Paths.typeNodeType = field_type,
Paths.typeNodeLinks = field_links}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TypeNode")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeNodeId
typeNodeId :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeNodeId
typeNodeId cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "root" DecodeCore.name fieldMap cx) (\field_root -> Eithers.bind (ExtractCore.requireField "path" subtypePath fieldMap cx) (\field_path -> Right (Paths.TypeNodeId {
Paths.typeNodeIdRoot = field_root,
Paths.typeNodeIdPath = field_path}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TypeNodeId")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeReference
typeReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeReference
typeReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermInject v0 ->
let field = Core.injectionField v0
fname = Core.fieldName field
fterm = Core.fieldTerm field
variantMap =
Maps.fromList [
(Core.Name "nominal", (\input -> Eithers.map (\t -> Paths.TypeReferenceNominal t) (nominalTypeReference cx input))),
(Core.Name "variable", (\input -> Eithers.map (\t -> Paths.TypeReferenceVariable t) (typeVariableReference cx input)))]
in (Optionals.match (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [
"no such field ",
(Core.unName fname),
" in union"]))) (\f -> f fterm))
_ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeReferenceLink
typeReferenceLink :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeReferenceLink
typeReferenceLink cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "step" subtypeStep fieldMap cx) (\field_step -> Eithers.bind (ExtractCore.requireField "target" typeReference fieldMap cx) (\field_target -> Right (Paths.TypeReferenceLink {
Paths.typeReferenceLinkStep = field_step,
Paths.typeReferenceLinkTarget = field_target}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TypeReferenceLink")) (ExtractCore.stripWithDecodingError cx raw)
-- | Decoder for hydra.paths.TypeVariableReference
typeVariableReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.TypeVariableReference
typeVariableReference cx raw =
Eithers.either (\err -> Left err) (\stripped -> case stripped of
Core.TermRecord v0 ->
let fieldMap = ExtractCore.toFieldMap v0
in (Eithers.bind (ExtractCore.requireField "variable" DecodeCore.name fieldMap cx) (\field_variable -> Eithers.bind (ExtractCore.requireField "boundByNode" typeNodeId fieldMap cx) (\field_boundByNode -> Right (Paths.TypeVariableReference {
Paths.typeVariableReferenceVariable = field_variable,
Paths.typeVariableReferenceBoundByNode = field_boundByNode}))))
_ -> Left (Errors.DecodingError "expected a record of type hydra.paths.TypeVariableReference")) (ExtractCore.stripWithDecodingError cx raw)