hydra-0.15.0: src/main/haskell/Hydra/Validate/Pg.hs
-- Note: this is an automatically generated file. Do not edit.
-- | Validation functions for property graphs
module Hydra.Validate.Pg where
import qualified Hydra.Error.Pg as Pg
import qualified Hydra.Lib.Equality as Equality
import qualified Hydra.Lib.Lists as Lists
import qualified Hydra.Lib.Logic as Logic
import qualified Hydra.Lib.Maps as Maps
import qualified Hydra.Lib.Maybes as Maybes
import qualified Hydra.Lib.Pairs as Pairs
import qualified Hydra.Pg.Model as Model
import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci
import qualified Data.Map as M
checkAll :: [Maybe t0] -> Maybe t0
checkAll checks =
let errors = Maybes.cat checks
in (Lists.maybeHead errors)
validateEdge :: (t0 -> t1 -> Maybe Pg.InvalidValueError) -> Maybe (t1 -> Maybe Model.VertexLabel) -> Model.EdgeType t0 -> Model.Edge t1 -> Maybe Pg.InvalidEdgeError
validateEdge checkValue labelForVertexId typ el =
let checkLabel =
let expected = Model.edgeTypeLabel typ
actual = Model.edgeLabel el
in (Logic.ifElse (Equality.equal (Model.unEdgeLabel actual) (Model.unEdgeLabel expected)) Nothing (Just (Pg.InvalidEdgeErrorLabel (Pg.NoSuchEdgeLabelError {
Pg.noSuchEdgeLabelErrorLabel = actual}))))
checkId = Maybes.map (\err -> Pg.InvalidEdgeErrorId err) (checkValue (Model.edgeTypeId typ) (Model.edgeId el))
checkProperties =
Maybes.map (\err -> Pg.InvalidEdgeErrorProperty err) (validateProperties checkValue (Model.edgeTypeProperties typ) (Model.edgeProperties el))
checkOut =
Maybes.maybe Nothing (\f -> Maybes.maybe (Just Pg.InvalidEdgeErrorOutVertexNotFound) (\label -> Logic.ifElse (Equality.equal (Model.unVertexLabel label) (Model.unVertexLabel (Model.edgeTypeOut typ))) Nothing (Just (Pg.InvalidEdgeErrorOutVertexLabel (Pg.WrongVertexLabelError {
Pg.wrongVertexLabelErrorExpected = (Model.edgeTypeOut typ),
Pg.wrongVertexLabelErrorActual = label})))) (f (Model.edgeOut el))) labelForVertexId
checkIn =
Maybes.maybe Nothing (\f -> Maybes.maybe (Just Pg.InvalidEdgeErrorInVertexNotFound) (\label -> Logic.ifElse (Equality.equal (Model.unVertexLabel label) (Model.unVertexLabel (Model.edgeTypeIn typ))) Nothing (Just (Pg.InvalidEdgeErrorInVertexLabel (Pg.WrongVertexLabelError {
Pg.wrongVertexLabelErrorExpected = (Model.edgeTypeIn typ),
Pg.wrongVertexLabelErrorActual = label})))) (f (Model.edgeIn el))) labelForVertexId
in (checkAll [
checkLabel,
checkId,
checkProperties,
checkOut,
checkIn])
validateGraph :: Ord t1 => ((t0 -> t1 -> Maybe Pg.InvalidValueError) -> Model.GraphSchema t0 -> Model.Graph t1 -> Maybe (Pg.InvalidGraphError t1))
validateGraph checkValue schema graph =
let checkVertices =
let checkVertex =
\el -> Maybes.maybe (Just (Pg.InvalidGraphErrorVertex (Pg.InvalidGraphVertexError {
Pg.invalidGraphVertexErrorId = (Model.vertexId el),
Pg.invalidGraphVertexErrorError = (Pg.InvalidVertexErrorLabel (Pg.NoSuchVertexLabelError {
Pg.noSuchVertexLabelErrorLabel = (Model.vertexLabel el)}))}))) (\t -> Maybes.map (\err -> Pg.InvalidGraphErrorVertex (Pg.InvalidGraphVertexError {
Pg.invalidGraphVertexErrorId = (Model.vertexId el),
Pg.invalidGraphVertexErrorError = err})) (validateVertex checkValue t el)) (Maps.lookup (Model.vertexLabel el) (Model.graphSchemaVertices schema))
in (checkAll (Lists.map checkVertex (Maps.elems (Model.graphVertices graph))))
checkEdges =
let checkEdge =
\el -> Maybes.maybe (Just (Pg.InvalidGraphErrorEdge (Pg.InvalidGraphEdgeError {
Pg.invalidGraphEdgeErrorId = (Model.edgeId el),
Pg.invalidGraphEdgeErrorError = (Pg.InvalidEdgeErrorLabel (Pg.NoSuchEdgeLabelError {
Pg.noSuchEdgeLabelErrorLabel = (Model.edgeLabel el)}))}))) (\t -> Maybes.map (\err -> Pg.InvalidGraphErrorEdge (Pg.InvalidGraphEdgeError {
Pg.invalidGraphEdgeErrorId = (Model.edgeId el),
Pg.invalidGraphEdgeErrorError = err})) (validateEdge checkValue labelForVertexId t el)) (Maps.lookup (Model.edgeLabel el) (Model.graphSchemaEdges schema))
labelForVertexId = Just (\i -> Maybes.map Model.vertexLabel (Maps.lookup i (Model.graphVertices graph)))
in (checkAll (Lists.map checkEdge (Maps.elems (Model.graphEdges graph))))
in (checkAll [
checkVertices,
checkEdges])
validateProperties :: (t0 -> t1 -> Maybe Pg.InvalidValueError) -> [Model.PropertyType t0] -> M.Map Model.PropertyKey t1 -> Maybe Pg.InvalidElementPropertyError
validateProperties checkValue types props =
let checkTypes = checkAll (Lists.map checkType types)
checkType =
\t -> Logic.ifElse (Model.propertyTypeRequired t) (Maybes.maybe (Just (Pg.InvalidElementPropertyError {
Pg.invalidElementPropertyErrorKey = (Model.propertyTypeKey t),
Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorMissingRequired (Model.propertyTypeKey t))})) (\_ -> Nothing) (Maps.lookup (Model.propertyTypeKey t) props)) Nothing
checkValues =
let m = Maps.fromList (Lists.map (\p -> (Model.propertyTypeKey p, (Model.propertyTypeValue p))) types)
checkPair =
\pair ->
let key = Pairs.first pair
val = Pairs.second pair
in (Maybes.maybe (Just (Pg.InvalidElementPropertyError {
Pg.invalidElementPropertyErrorKey = key,
Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorUnexpectedKey key)})) (\typ -> Maybes.map (\err -> Pg.InvalidElementPropertyError {
Pg.invalidElementPropertyErrorKey = key,
Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorInvalidValue err)}) (checkValue typ val)) (Maps.lookup key m))
in (checkAll (Lists.map checkPair (Maps.toList props)))
in (checkAll [
checkTypes,
checkValues])
validateVertex :: (t0 -> t1 -> Maybe Pg.InvalidValueError) -> Model.VertexType t0 -> Model.Vertex t1 -> Maybe Pg.InvalidVertexError
validateVertex checkValue typ el =
let checkLabel =
let expected = Model.vertexTypeLabel typ
actual = Model.vertexLabel el
in (Logic.ifElse (Equality.equal (Model.unVertexLabel actual) (Model.unVertexLabel expected)) Nothing (Just (Pg.InvalidVertexErrorLabel (Pg.NoSuchVertexLabelError {
Pg.noSuchVertexLabelErrorLabel = actual}))))
checkId = Maybes.map (\err -> Pg.InvalidVertexErrorId err) (checkValue (Model.vertexTypeId typ) (Model.vertexId el))
checkProperties =
Maybes.map (\err -> Pg.InvalidVertexErrorProperty err) (validateProperties checkValue (Model.vertexTypeProperties typ) (Model.vertexProperties el))
in (checkAll [
checkLabel,
checkId,
checkProperties])