TermsToElements.hs

-- Note: this is an automatically generated file. Do not edit.
-- | Functions for mapping Hydra terms to property graph elements using mapping specifications

module Hydra.Pg.TermsToElements where
import qualified Hydra.Annotations as Annotations
import qualified Hydra.Ast as Ast
import qualified Hydra.Coders as Coders
import qualified Hydra.Core as Core
import qualified Hydra.Error.Checking as Checking
import qualified Hydra.Error.Core as ErrorCore
import qualified Hydra.Error.File as ErrorFile
import qualified Hydra.Error.Packaging as ErrorPackaging
import qualified Hydra.Error.System as ErrorSystem
import qualified Hydra.Errors as Errors
import qualified Hydra.Extract.Core as ExtractCore
import qualified Hydra.File as File
import qualified Hydra.Graph as Graph
import qualified Hydra.Json.Model as JsonModel
import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers
import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality
import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists
import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals
import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic
import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs
import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Pg.Mapping as Mapping
import qualified Hydra.Pg.Model as PgModel
import qualified Hydra.Query as Query
import qualified Hydra.Relational as Relational
import qualified Hydra.Resolution as Resolution
import qualified Hydra.Show.Core as ShowCore
import qualified Hydra.Strip as Strip
import qualified Hydra.System as System
import qualified Hydra.Tabular as Tabular
import qualified Hydra.Testing as Testing
import qualified Hydra.Time as Time
import qualified Hydra.Topology as Topology
import qualified Hydra.Typed as Typed
import qualified Hydra.Typing as Typing
import qualified Hydra.Util as Util
import qualified Hydra.Validation as Validation
import qualified Hydra.Variants as Variants
import Prelude hiding  (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci
import qualified Data.Map as M
-- | Apply a parsed pattern to a term, producing string terms
applyPattern :: t0 -> String -> [([String], String)] -> Core.Term -> Either Errors.Error [Core.Term]
applyPattern cx firstLit pairs term =
    Logic.ifElse (Lists.null pairs) (Right [
      Core.TermLiteral (Core.LiteralString firstLit)]) (Eithers.bind (Eithers.mapList (\pp -> Eithers.map (\terms -> (Lists.map (\t -> termToString t) terms, (Pairs.second pp))) (evalPath cx (Pairs.first pp) term)) pairs) (\evaluated -> Right (Lists.map (\s -> Core.TermLiteral (Core.LiteralString s)) (Lists.foldl (\accum -> \ep ->
      let pStrs = Pairs.first ep
          litP = Pairs.second ep
      in (Lists.concat (Lists.map (\pStr -> Lists.map (\a -> Strings.cat2 (Strings.cat2 a pStr) litP) accum) pStrs))) [
      firstLit] evaluated))))
-- | Decode an edge label from a term
decodeEdgeLabel :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error PgModel.EdgeLabel
decodeEdgeLabel cx g t = Eithers.map (\_x -> PgModel.EdgeLabel _x) (ExtractCore.string g t)
-- | Decode an edge specification from a term
decodeEdgeSpec :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Mapping.EdgeSpec
decodeEdgeSpec cx g term =
    readRecord cx g (\fields -> Eithers.bind (readField cx fields (Core.Name "label") (decodeEdgeLabel cx g)) (\_a -> Eithers.bind (readField cx fields (Core.Name "id") (decodeValueSpec cx g)) (\_b -> Eithers.bind (readField cx fields (Core.Name "out") (decodeValueSpec cx g)) (\_c -> Eithers.bind (readField cx fields (Core.Name "in") (decodeValueSpec cx g)) (\_d -> Eithers.map (\_e -> Mapping.EdgeSpec {
      Mapping.edgeSpecLabel = _a,
      Mapping.edgeSpecId = _b,
      Mapping.edgeSpecOut = _c,
      Mapping.edgeSpecIn = _d,
      Mapping.edgeSpecProperties = _e}) (readField cx fields (Core.Name "properties") (expectList cx g decodePropertySpec))))))) term
-- | Decode an element specification from a term
decodeElementSpec :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Mapping.ElementSpec
decodeElementSpec cx g term =
    readInjection cx g [
      (Core.Name "vertex", (\t -> Eithers.map (\_x -> Mapping.ElementSpecVertex _x) (decodeVertexSpec cx g t))),
      (Core.Name "edge", (\t -> Eithers.map (\_x -> Mapping.ElementSpecEdge _x) (decodeEdgeSpec cx g t)))] term
-- | Decode a property key from a term
decodePropertyKey :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error PgModel.PropertyKey
decodePropertyKey cx g t = Eithers.map (\_x -> PgModel.PropertyKey _x) (ExtractCore.string g t)
-- | Decode a property specification from a term
decodePropertySpec :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Mapping.PropertySpec
decodePropertySpec cx g term =
    readRecord cx g (\fields -> Eithers.bind (readField cx fields (Core.Name "key") (decodePropertyKey cx g)) (\_a -> Eithers.map (\_b -> Mapping.PropertySpec {
      Mapping.propertySpecKey = _a,
      Mapping.propertySpecValue = _b}) (readField cx fields (Core.Name "value") (decodeValueSpec cx g)))) term
-- | Decode a value specification from a term
decodeValueSpec :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Mapping.ValueSpec
decodeValueSpec cx g term =
    case (Strip.deannotateTerm term) of
      Core.TermLiteral v0 -> case v0 of
        Core.LiteralString v1 -> Right (Mapping.ValueSpecPattern v1)
        _ -> readInjection cx g [
          (Core.Name "value", (\_ -> Right Mapping.ValueSpecValue)),
          (Core.Name "pattern", (\t -> Eithers.map (\_x -> Mapping.ValueSpecPattern _x) (ExtractCore.string g t)))] term
      _ -> readInjection cx g [
        (Core.Name "value", (\_ -> Right Mapping.ValueSpecValue)),
        (Core.Name "pattern", (\t -> Eithers.map (\_x -> Mapping.ValueSpecPattern _x) (ExtractCore.string g t)))] term
-- | Decode a vertex label from a term
decodeVertexLabel :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error PgModel.VertexLabel
decodeVertexLabel cx g t = Eithers.map (\_x -> PgModel.VertexLabel _x) (ExtractCore.string g t)
-- | Decode a vertex specification from a term
decodeVertexSpec :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Mapping.VertexSpec
decodeVertexSpec cx g term =
    readRecord cx g (\fields -> Eithers.bind (readField cx fields (Core.Name "label") (decodeVertexLabel cx g)) (\_a -> Eithers.bind (readField cx fields (Core.Name "id") (decodeValueSpec cx g)) (\_b -> Eithers.map (\_c -> Mapping.VertexSpec {
      Mapping.vertexSpecLabel = _a,
      Mapping.vertexSpecId = _b,
      Mapping.vertexSpecProperties = _c}) (readField cx fields (Core.Name "properties") (expectList cx g decodePropertySpec))))) term
-- | Evaluate a path (list of steps) on a term, returning all resulting terms
evalPath :: t0 -> [String] -> Core.Term -> Either Errors.Error [Core.Term]
evalPath cx path term =
    Optionals.cases (Lists.uncons path) (Right [
      term]) (\p -> Eithers.bind (evalStep cx (Pairs.first p) term) (\results -> Eithers.map (\xs -> Lists.concat xs) (Eithers.mapList (evalPath cx (Pairs.second p)) results)))
-- | Evaluate a single step of a path traversal on a term
evalStep :: t0 -> String -> Core.Term -> Either Errors.Error [Core.Term]
evalStep cx step term =
    Logic.ifElse (Strings.null step) (Right [
      term]) (case (Strip.deannotateTerm term) of
      Core.TermList v0 -> Eithers.map (\xs -> Lists.concat xs) (Eithers.mapList (evalStep cx step) v0)
      Core.TermOptional v0 -> Optionals.cases v0 (Right []) (\t -> evalStep cx step t)
      Core.TermRecord v0 -> Optionals.cases (Maps.lookup (Core.Name step) (Resolution.fieldMap (Core.recordFields v0))) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 "No such field " step) " in record")))) (\t -> Right [
        t])
      Core.TermInject v0 -> Logic.ifElse (Equality.equal (Core.unName (Core.fieldName (Core.injectionField v0))) step) (evalStep cx step (Core.fieldTerm (Core.injectionField v0))) (Right [])
      Core.TermWrap v0 -> evalStep cx step (Core.wrappedTermBody v0)
      _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "Can't traverse through term for step " step))))
-- | Extract a list from a term and apply a decoder to each element
expectList :: t0 -> Graph.Graph -> (t0 -> Graph.Graph -> Core.Term -> Either Errors.Error t1) -> Core.Term -> Either Errors.Error [t1]
expectList cx g f term = Eithers.bind (ExtractCore.list g term) (\elems -> Eithers.mapList (f cx g) elems)
-- | Parse an edge id pattern from a value spec and schema
parseEdgeIdPattern :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.ValueSpec -> Either t5 (Core.Term -> Either Errors.Error [t4])
parseEdgeIdPattern cx g schema spec =
    Eithers.bind (parseValueSpec cx g spec) (\fun -> Right (\term -> Eithers.bind (fun term) (\terms -> Eithers.mapList (Coders.coderEncode (Mapping.schemaEdgeIds schema)) terms)))
-- | Parse an edge specification into a label and encoder function
parseEdgeSpec :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.EdgeSpec -> Either t5 (PgModel.Label, (Core.Term -> Either Errors.Error [PgModel.Element t4]))
parseEdgeSpec cx g schema spec =

      let label = Mapping.edgeSpecLabel spec
          id = Mapping.edgeSpecId spec
          outV = Mapping.edgeSpecOut spec
          inV = Mapping.edgeSpecIn spec
          props = Mapping.edgeSpecProperties spec
      in (Eithers.bind (parseEdgeIdPattern cx g schema id) (\getId -> Eithers.bind (parseVertexIdPattern cx g schema outV) (\getOut -> Eithers.bind (parseVertexIdPattern cx g schema inV) (\getIn -> Eithers.bind (Eithers.mapList (parsePropertySpec cx g schema) props) (\getProps -> Right (
        PgModel.LabelEdge label,
        (\term -> Eithers.bind (requireUnique cx "edge id" getId term) (\tid -> Eithers.bind (requireUnique cx "vertex id" getOut term) (\tout -> Eithers.bind (requireUnique cx "edge id" getIn term) (\tin -> Eithers.bind (Eithers.map (\_xs -> Maps.fromList _xs) (Eithers.mapList (\gf -> requireUnique cx "property key" gf term) getProps)) (\tprops -> Right [
          PgModel.ElementEdge (PgModel.Edge {
            PgModel.edgeLabel = label,
            PgModel.edgeId = tid,
            PgModel.edgeOut = tout,
            PgModel.edgeIn = tin,
            PgModel.edgeProperties = tprops})])))))))))))
-- | Parse an element specification into a label and encoder function
parseElementSpec :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.ElementSpec -> Either t5 (PgModel.Label, (Core.Term -> Either Errors.Error [PgModel.Element t4]))
parseElementSpec cx g schema spec =
    case spec of
      Mapping.ElementSpecVertex v0 -> parseVertexSpec cx g schema v0
      Mapping.ElementSpecEdge v0 -> parseEdgeSpec cx g schema v0
-- | Parse a string pattern into a function that traverses terms
parsePattern :: t0 -> t1 -> String -> Either t2 (Core.Term -> Either Errors.Error [Core.Term])
parsePattern cx _g pat =

      let segments = Strings.splitOn "${" pat
          firstLit = Optionals.fromOptional pat (Lists.maybeHead segments)
          rest = Lists.drop 1 segments
          parsed =
                  Lists.map (\seg ->
                    let parts = Strings.splitOn "}" seg
                        pathStr = Optionals.fromOptional "" (Lists.maybeHead parts)
                        litPart = Strings.intercalate "}" (Lists.drop 1 parts)
                        pathSteps = Strings.splitOn "/" pathStr
                    in (pathSteps, litPart)) rest
      in (Right (\term -> applyPattern cx firstLit parsed term))
-- | Parse a property specification into an encoder function
parsePropertySpec :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.PropertySpec -> Either t5 (Core.Term -> Either Errors.Error [(PgModel.PropertyKey, t4)])
parsePropertySpec cx g schema spec =

      let key = Mapping.propertySpecKey spec
          value = Mapping.propertySpecValue spec
      in (Eithers.bind (parseValueSpec cx g value) (\fun -> Right (\term -> Eithers.bind (fun term) (\results -> Eithers.bind (Eithers.mapList (Coders.coderEncode (Mapping.schemaPropertyValues schema)) results) (\values -> Right (Lists.map (\v -> (key, v)) values))))))
-- | Parse a value specification into a function that processes terms
parseValueSpec :: t0 -> t1 -> Mapping.ValueSpec -> Either t2 (Core.Term -> Either Errors.Error [Core.Term])
parseValueSpec cx g spec =
    case spec of
      Mapping.ValueSpecValue -> Right (\term -> Right [
        term])
      Mapping.ValueSpecPattern v0 -> parsePattern cx g v0
-- | Parse a vertex id pattern from a value spec and schema
parseVertexIdPattern :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.ValueSpec -> Either t5 (Core.Term -> Either Errors.Error [t4])
parseVertexIdPattern cx g schema spec =
    Eithers.bind (parseValueSpec cx g spec) (\fun -> Right (\term -> Eithers.bind (fun term) (\terms -> Eithers.mapList (Coders.coderEncode (Mapping.schemaVertexIds schema)) terms)))
-- | Parse a vertex specification into a label and encoder function
parseVertexSpec :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> Mapping.VertexSpec -> Either t5 (PgModel.Label, (Core.Term -> Either Errors.Error [PgModel.Element t4]))
parseVertexSpec cx g schema spec =

      let label = Mapping.vertexSpecLabel spec
          id = Mapping.vertexSpecId spec
          props = Mapping.vertexSpecProperties spec
      in (Eithers.bind (parseVertexIdPattern cx g schema id) (\getId -> Eithers.bind (Eithers.mapList (parsePropertySpec cx g schema) props) (\getProps -> Right (
        PgModel.LabelVertex label,
        (\term -> Eithers.bind (requireUnique cx "vertex id" getId term) (\tid -> Eithers.bind (Eithers.map (\_xs -> Maps.fromList _xs) (Eithers.mapList (\gf -> requireUnique cx "property key" gf term) getProps)) (\tprops -> Right [
          PgModel.ElementVertex (PgModel.Vertex {
            PgModel.vertexLabel = label,
            PgModel.vertexId = tid,
            PgModel.vertexProperties = tprops})])))))))
-- | Read a field from a map of fields by name
readField :: t0 -> M.Map Core.Name t1 -> Core.Name -> (t1 -> Either Errors.Error t2) -> Either Errors.Error t2
readField cx fields fname fun =
    Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no such field: " (Core.unName fname))))) fun
-- | Read an injection (union value) from a term
readInjection :: t0 -> Graph.Graph -> [(Core.Name, (Core.Term -> Either Errors.Error t1))] -> Core.Term -> Either Errors.Error t1
readInjection cx g cases encoded =
    Eithers.bind (ExtractCore.map (\k -> Eithers.map (\_n -> Core.Name _n) (ExtractCore.string g k)) (\_v -> Right _v) g encoded) (\mp ->
      let entries = Maps.toList mp
      in (Optionals.cases (Lists.maybeHead entries) (Left (Errors.ErrorOther (Errors.OtherError "empty injection"))) (\f ->
        let key = Pairs.first f
            val = Pairs.second f
            matching = Lists.filter (\c -> Equality.equal (Pairs.first c) key) cases
        in (Optionals.cases (Lists.maybeHead matching) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "unexpected field: " (Core.unName key))))) (\m ->
          let handler = Pairs.second m
          in (handler val))))))
-- | Read a record from a term as a map of field names to values
readRecord :: t0 -> Graph.Graph -> (M.Map Core.Name Core.Term -> Either Errors.Error t1) -> Core.Term -> Either Errors.Error t1
readRecord cx g cons term =
    Eithers.bind (ExtractCore.map (\k -> Eithers.map (\_n -> Core.Name _n) (ExtractCore.string g k)) (\_v -> Right _v) g term) cons
-- | Require exactly one result from a list-producing function
requireUnique :: t0 -> String -> (t1 -> Either Errors.Error [t2]) -> t1 -> Either Errors.Error t2
requireUnique cx context fun term =
    Eithers.bind (fun term) (\results -> Logic.ifElse (Lists.null results) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "No value found: " context)))) (Logic.ifElse (Equality.equal (Lists.length results) 1) (Optionals.cases (Lists.maybeHead results) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "Multiple values found: " context)))) (\x -> Right x)) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "Multiple values found: " context))))))
-- | Create an adapter that maps terms to property graph elements using a mapping specification
termToElementsAdapter :: t0 -> Graph.Graph -> Mapping.Schema t1 t2 t3 Errors.Error -> Core.Type -> Either Errors.Error (Coders.Adapter Core.Type [PgModel.Label] Core.Term [PgModel.Element t3] Errors.Error)
termToElementsAdapter cx g schema typ =

      let key_elements = Core.Name "elements"
      in (Optionals.cases (Annotations.getTypeAnnotation key_elements typ) (Right (Coders.Adapter {
        Coders.adapterIsLossy = False,
        Coders.adapterSource = typ,
        Coders.adapterTarget = [],
        Coders.adapterCoder = Coders.Coder {
          Coders.coderEncode = (\_t -> Right []),
          Coders.coderDecode = (\_els -> Left (Errors.ErrorOther (Errors.OtherError "no corresponding element type")))}})) (\term -> Eithers.bind (expectList cx g decodeElementSpec term) (\specTerms -> Eithers.bind (Eithers.mapList (parseElementSpec cx g schema) specTerms) (\specs ->
        let labels = Lists.nub (Lists.map (\_p -> Pairs.first _p) specs)
            encoders = Lists.map (\_p -> Pairs.second _p) specs
        in (Right (Coders.Adapter {
          Coders.adapterIsLossy = False,
          Coders.adapterSource = typ,
          Coders.adapterTarget = labels,
          Coders.adapterCoder = Coders.Coder {
            Coders.coderEncode = (\t -> Eithers.map (\_xs -> Lists.concat _xs) (Eithers.mapList (\e -> e t) encoders)),
            Coders.coderDecode = (\_els -> Left (Errors.ErrorOther (Errors.OtherError "element decoding is not yet supported")))}}))))))
-- | Convert a term to its string representation
termToString :: Core.Term -> String
termToString term =
    case (Strip.deannotateTerm term) of
      Core.TermLiteral v0 -> case v0 of
        Core.LiteralString v1 -> v1
        Core.LiteralBoolean v1 -> Logic.ifElse v1 "true" "false"
        Core.LiteralInteger v1 -> case v1 of
          Core.IntegerValueInt32 v2 -> Literals.showInt32 v2
          _ -> ShowCore.term term
        Core.LiteralFloat v1 -> case v1 of
          Core.FloatValueFloat64 v2 -> Literals.showFloat64 v2
          _ -> ShowCore.term term
        _ -> ShowCore.term term
      Core.TermOptional v0 -> Optionals.cases v0 "none" (\t -> termToString t)
      _ -> ShowCore.term term