hydra-pg-0.17.0: src/main/haskell/Hydra/Pg/Utils.hs
-- Note: this is an automatically generated file. Do not edit.
-- | Utility functions for property graph operations
module Hydra.Pg.Utils where
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.Lists as Lists
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.Sets as Sets
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Pg.Coder as Coder
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.Show.Core as ShowCore
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
-- | Default Tinkerpop annotation schema
defaultTinkerpopAnnotations :: Mapping.AnnotationSchema
defaultTinkerpopAnnotations =
Mapping.AnnotationSchema {
Mapping.annotationSchemaVertexLabel = "vertexLabel",
Mapping.annotationSchemaEdgeLabel = "edgeLabel",
Mapping.annotationSchemaVertexId = "vertexId",
Mapping.annotationSchemaEdgeId = "edgeId",
Mapping.annotationSchemaPropertyKey = "key",
Mapping.annotationSchemaPropertyValue = "value",
Mapping.annotationSchemaOutVertex = "outVertex",
Mapping.annotationSchemaOutVertexLabel = "outVertexLabel",
Mapping.annotationSchemaInVertex = "inVertex",
Mapping.annotationSchemaInVertexLabel = "inVertexLabel",
Mapping.annotationSchemaOutEdge = "outEdge",
Mapping.annotationSchemaOutEdgeLabel = "outEdgeLabel",
Mapping.annotationSchemaInEdge = "inEdge",
Mapping.annotationSchemaInEdgeLabel = "inEdgeLabel",
Mapping.annotationSchemaIgnore = "ignore"}
-- | Example property graph schema with string values
examplePgSchema :: Mapping.Schema t0 () String Errors.Error
examplePgSchema =
Mapping.Schema {
Mapping.schemaVertexIdTypes = Coders.Coder {
Coders.coderEncode = (\_2 -> Right ()),
Coders.coderDecode = (\_2 -> Right Core.TypeUnit)},
Mapping.schemaVertexIds = Coders.Coder {
Coders.coderEncode = (\t -> expString t),
Coders.coderDecode = (\s -> Right (Core.TermLiteral (Core.LiteralString s)))},
Mapping.schemaEdgeIdTypes = Coders.Coder {
Coders.coderEncode = (\_2 -> Right ()),
Coders.coderDecode = (\_2 -> Right Core.TypeUnit)},
Mapping.schemaEdgeIds = Coders.Coder {
Coders.coderEncode = (\t -> expString t),
Coders.coderDecode = (\s -> Right (Core.TermLiteral (Core.LiteralString s)))},
Mapping.schemaPropertyTypes = Coders.Coder {
Coders.coderEncode = (\_2 -> Right ()),
Coders.coderDecode = (\_2 -> Right Core.TypeUnit)},
Mapping.schemaPropertyValues = Coders.Coder {
Coders.coderEncode = (\t -> expString t),
Coders.coderDecode = (\s -> Right (Core.TermLiteral (Core.LiteralString s)))},
Mapping.schemaAnnotations = defaultTinkerpopAnnotations,
Mapping.schemaDefaultVertexId = "defaultVertexId",
Mapping.schemaDefaultEdgeId = "defaultEdgeId"}
-- | Extract a string from a term using the empty graph
expString :: Core.Term -> Either Errors.Error String
expString term =
ExtractCore.string (Graph.Graph {
Graph.graphBoundTerms = Maps.empty,
Graph.graphBoundTypes = Maps.empty,
Graph.graphClassConstraints = Maps.empty,
Graph.graphLambdaVariables = Sets.empty,
Graph.graphMetadata = Maps.empty,
Graph.graphPrimitives = Maps.empty,
Graph.graphSchemaTypes = Maps.empty,
Graph.graphTypeVariables = Sets.empty}) term
-- | Get all elements from a lazy graph
lazyGraphToElements :: PgModel.LazyGraph t0 -> [PgModel.Element t0]
lazyGraphToElements lg =
Lists.concat2 (Lists.map (\x -> PgModel.ElementVertex x) (PgModel.lazyGraphVertices lg)) (Lists.map (\x -> PgModel.ElementEdge x) (PgModel.lazyGraphEdges lg))
-- | Convert a property graph element to JSON
pgElementToJson :: Mapping.Schema t0 t1 t2 Errors.Error -> PgModel.Element t2 -> Either Errors.Error JsonModel.Value
pgElementToJson schema el =
(\x -> case x of
PgModel.ElementVertex v0 -> Eithers.bind (Coders.coderDecode (Mapping.schemaVertexIds schema) (PgModel.vertexId v0)) (\term ->
let labelJson = JsonModel.ValueString (PgModel.unVertexLabel (PgModel.vertexLabel v0))
in (Eithers.map (\propsJson -> JsonModel.ValueObject (Optionals.cat [
Just ("label", labelJson),
(Just ("id", (JsonModel.ValueString (ShowCore.term term)))),
propsJson])) ((\pairs -> Logic.ifElse (Maps.null pairs) (Right Nothing) (Eithers.map (\p -> Just ("properties", (JsonModel.ValueObject p))) (Eithers.mapList (\pair ->
let key = Pairs.first pair
v = Pairs.second pair
in (Eithers.bind (Coders.coderDecode (Mapping.schemaPropertyValues schema) v) (\term2 -> Right (PgModel.unPropertyKey key, (JsonModel.ValueString (ShowCore.term term2)))))) (Maps.toList pairs)))) (PgModel.vertexProperties v0))))
PgModel.ElementEdge v0 -> Eithers.bind (Coders.coderDecode (Mapping.schemaEdgeIds schema) (PgModel.edgeId v0)) (\term -> Eithers.bind (Coders.coderDecode (Mapping.schemaVertexIds schema) (PgModel.edgeOut v0)) (\termOut -> Eithers.bind (Coders.coderDecode (Mapping.schemaVertexIds schema) (PgModel.edgeIn v0)) (\termIn ->
let labelJson = JsonModel.ValueString (PgModel.unEdgeLabel (PgModel.edgeLabel v0))
in (Eithers.map (\propsJson -> JsonModel.ValueObject (Optionals.cat [
Just ("label", labelJson),
(Just ("id", (JsonModel.ValueString (ShowCore.term term)))),
(Just ("out", (JsonModel.ValueString (ShowCore.term termOut)))),
(Just ("in", (JsonModel.ValueString (ShowCore.term termIn)))),
propsJson])) ((\pairs -> Logic.ifElse (Maps.null pairs) (Right Nothing) (Eithers.map (\p -> Just ("properties", (JsonModel.ValueObject p))) (Eithers.mapList (\pair ->
let key = Pairs.first pair
v = Pairs.second pair
in (Eithers.bind (Coders.coderDecode (Mapping.schemaPropertyValues schema) v) (\term2 -> Right (PgModel.unPropertyKey key, (JsonModel.ValueString (ShowCore.term term2)))))) (Maps.toList pairs)))) (PgModel.edgeProperties v0))))))) el
-- | Convert a list of property graph elements to JSON
pgElementsToJson :: Mapping.Schema t0 t1 t2 Errors.Error -> [PgModel.Element t2] -> Either Errors.Error JsonModel.Value
pgElementsToJson schema els =
Eithers.map (\els_ -> JsonModel.ValueArray els_) (Eithers.mapList (\el -> pgElementToJson schema el) els)
-- | Get all elements from a property graph
propertyGraphElements :: Ord t0 => (PgModel.Graph t0 -> [PgModel.Element t0])
propertyGraphElements g =
Lists.concat2 (Lists.map (\x -> PgModel.ElementVertex x) (Maps.elems (PgModel.graphVertices g))) (Lists.map (\x -> PgModel.ElementEdge x) (Maps.elems (PgModel.graphEdges g)))
-- | Convert a type-annotated term to property graph elements
typeApplicationTermToPropertyGraph :: Mapping.Schema t0 t1 t2 Errors.Error -> Core.Type -> t1 -> t1 -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error (Core.Term -> Either Errors.Error [PgModel.Element t2])
typeApplicationTermToPropertyGraph schema typ vidType eidType cx g =
Eithers.bind (Coder.elementCoder Nothing schema typ vidType eidType cx g) (\adapter -> Right (\term -> Eithers.map (\tree ->
let flattenTree =
\t -> Lists.cons (PgModel.elementTreeSelf t) (Lists.concat (Lists.map flattenTree (PgModel.elementTreeDependencies t)))
in (flattenTree tree)) (Coders.coderEncode (Coders.adapterCoder adapter) term)))