module Hydra.Langs.Tinkerpop.Validate where
import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PropertyGraph
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.Optionals as Optionals
import qualified Hydra.Lib.Strings as Strings
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S
validateEdge :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe PropertyGraph.VertexLabel) -> PropertyGraph.EdgeType t -> PropertyGraph.Edge v -> Maybe String)
validateEdge :: forall t v.
(t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> EdgeType t
-> Edge v
-> Maybe String
validateEdge t -> v -> Maybe String
checkValue v -> String
showValue Maybe (v -> Maybe VertexLabel)
labelForVertexId EdgeType t
typ Edge v
el =
let failWith :: String -> String
failWith = ((v -> String) -> Edge v -> String -> String
forall v. (v -> String) -> Edge v -> String -> String
edgeError v -> String
showValue Edge v
el)
checkLabel :: Maybe String
checkLabel =
let expected :: EdgeLabel
expected = (EdgeType t -> EdgeLabel
forall t. EdgeType t -> EdgeLabel
PropertyGraph.edgeTypeLabel EdgeType t
typ)
actual :: EdgeLabel
actual = (Edge v -> EdgeLabel
forall v. Edge v -> EdgeLabel
PropertyGraph.edgeLabel Edge v
el)
in (Bool -> String -> Maybe String
verify (String -> String -> Bool
Equality.equalString (EdgeLabel -> String
PropertyGraph.unEdgeLabel EdgeLabel
actual) (EdgeLabel -> String
PropertyGraph.unEdgeLabel EdgeLabel
expected)) (String -> String
failWith (String -> String -> String
prepend String
"Wrong label" (EdgeLabel -> EdgeLabel -> String
edgeLabelMismatch EdgeLabel
expected EdgeLabel
actual))))
checkId :: Maybe String
checkId = ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map (\String
x -> String -> String
failWith (String -> String -> String
prepend String
"Invalid id" String
x)) (t -> v -> Maybe String
checkValue (EdgeType t -> t
forall t. EdgeType t -> t
PropertyGraph.edgeTypeId EdgeType t
typ) (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeId Edge v
el)))
checkProperties :: Maybe String
checkProperties = ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map (\String
x -> String -> String
failWith (String -> String -> String
prepend String
"Invalid property" String
x)) ((t -> v -> Maybe String)
-> [PropertyType t] -> Map PropertyKey v -> Maybe String
forall t v.
(t -> v -> Maybe String)
-> [PropertyType t] -> Map PropertyKey v -> Maybe String
validateProperties t -> v -> Maybe String
checkValue (EdgeType t -> [PropertyType t]
forall t. EdgeType t -> [PropertyType t]
PropertyGraph.edgeTypeProperties EdgeType t
typ) (Edge v -> Map PropertyKey v
forall v. Edge v -> Map PropertyKey v
PropertyGraph.edgeProperties Edge v
el)))
checkOut :: Maybe String
checkOut = ((\Maybe (v -> Maybe VertexLabel)
x -> case Maybe (v -> Maybe VertexLabel)
x of
Maybe (v -> Maybe VertexLabel)
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just v -> Maybe VertexLabel
v286 -> ((\Maybe VertexLabel
x -> case Maybe VertexLabel
x of
Maybe VertexLabel
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
failWith (String -> String -> String
prepend String
"Out-vertex does not exist" (v -> String
showValue (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeOut Edge v
el)))))
Just VertexLabel
v287 -> (Bool -> String -> Maybe String
verify (String -> String -> Bool
Equality.equalString (VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
v287) (VertexLabel -> String
PropertyGraph.unVertexLabel (EdgeType t -> VertexLabel
forall t. EdgeType t -> VertexLabel
PropertyGraph.edgeTypeOut EdgeType t
typ))) (String -> String
failWith (String -> String -> String
prepend String
"Wrong out-vertex label" (VertexLabel -> VertexLabel -> String
vertexLabelMismatch (EdgeType t -> VertexLabel
forall t. EdgeType t -> VertexLabel
PropertyGraph.edgeTypeOut EdgeType t
typ) VertexLabel
v287))))) (v -> Maybe VertexLabel
v286 (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeOut Edge v
el)))) Maybe (v -> Maybe VertexLabel)
labelForVertexId)
checkIn :: Maybe String
checkIn = ((\Maybe (v -> Maybe VertexLabel)
x -> case Maybe (v -> Maybe VertexLabel)
x of
Maybe (v -> Maybe VertexLabel)
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just v -> Maybe VertexLabel
v288 -> ((\Maybe VertexLabel
x -> case Maybe VertexLabel
x of
Maybe VertexLabel
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
failWith (String -> String -> String
prepend String
"In-vertex does not exist" (v -> String
showValue (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeIn Edge v
el)))))
Just VertexLabel
v289 -> (Bool -> String -> Maybe String
verify (String -> String -> Bool
Equality.equalString (VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
v289) (VertexLabel -> String
PropertyGraph.unVertexLabel (EdgeType t -> VertexLabel
forall t. EdgeType t -> VertexLabel
PropertyGraph.edgeTypeIn EdgeType t
typ))) (String -> String
failWith (String -> String -> String
prepend String
"Wrong in-vertex label" (VertexLabel -> VertexLabel -> String
vertexLabelMismatch (EdgeType t -> VertexLabel
forall t. EdgeType t -> VertexLabel
PropertyGraph.edgeTypeIn EdgeType t
typ) VertexLabel
v289))))) (v -> Maybe VertexLabel
v288 (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeIn Edge v
el)))) Maybe (v -> Maybe VertexLabel)
labelForVertexId)
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll [
Maybe String
checkLabel,
Maybe String
checkId,
Maybe String
checkProperties,
Maybe String
checkOut,
Maybe String
checkIn])
validateElement :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe PropertyGraph.VertexLabel) -> PropertyGraph.ElementType t -> PropertyGraph.Element v -> Maybe String)
validateElement :: forall t v.
(t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> ElementType t
-> Element v
-> Maybe String
validateElement t -> v -> Maybe String
checkValue v -> String
showValue Maybe (v -> Maybe VertexLabel)
labelForVertexId ElementType t
typ Element v
el = ((\ElementType t
x -> case ElementType t
x of
PropertyGraph.ElementTypeVertex VertexType t
v290 -> ((\Element v
x -> case Element v
x of
PropertyGraph.ElementEdge Edge v
v291 -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String -> String
prepend String
"Edge instead of vertex" (v -> String
showValue (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeId Edge v
v291))))
PropertyGraph.ElementVertex Vertex v
v292 -> ((t -> v -> Maybe String)
-> (v -> String) -> VertexType t -> Vertex v -> Maybe String
forall t v.
(t -> v -> Maybe String)
-> (v -> String) -> VertexType t -> Vertex v -> Maybe String
validateVertex t -> v -> Maybe String
checkValue v -> String
showValue VertexType t
v290 Vertex v
v292)) Element v
el)
PropertyGraph.ElementTypeEdge EdgeType t
v293 -> ((\Element v
x -> case Element v
x of
PropertyGraph.ElementVertex Vertex v
v294 -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String -> String
prepend String
"Vertex instead of edge" (v -> String
showValue (Vertex v -> v
forall v. Vertex v -> v
PropertyGraph.vertexId Vertex v
v294))))
PropertyGraph.ElementEdge Edge v
v295 -> ((t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> EdgeType t
-> Edge v
-> Maybe String
forall t v.
(t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> EdgeType t
-> Edge v
-> Maybe String
validateEdge t -> v -> Maybe String
checkValue v -> String
showValue Maybe (v -> Maybe VertexLabel)
labelForVertexId EdgeType t
v293 Edge v
v295)) Element v
el)) ElementType t
typ)
validateGraph :: (Ord v) => ((t -> v -> Maybe String) -> (v -> String) -> PropertyGraph.GraphSchema t -> PropertyGraph.Graph v -> Maybe String)
validateGraph :: forall v t.
Ord v =>
(t -> v -> Maybe String)
-> (v -> String) -> GraphSchema t -> Graph v -> Maybe String
validateGraph t -> v -> Maybe String
checkValue v -> String
showValue GraphSchema t
schema Graph v
graph =
let checkVertices :: Maybe String
checkVertices =
let checkVertex :: Vertex v -> Maybe String
checkVertex = (\Vertex v
el -> (\Maybe (VertexType t)
x -> case Maybe (VertexType t)
x of
Maybe (VertexType t)
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just ((v -> String) -> Vertex v -> String -> String
forall v. (v -> String) -> Vertex v -> String -> String
vertexError v -> String
showValue Vertex v
el (String -> String -> String
prepend String
"Unexpected label" (VertexLabel -> String
PropertyGraph.unVertexLabel (Vertex v -> VertexLabel
forall v. Vertex v -> VertexLabel
PropertyGraph.vertexLabel Vertex v
el)))))
Just VertexType t
v296 -> ((t -> v -> Maybe String)
-> (v -> String) -> VertexType t -> Vertex v -> Maybe String
forall t v.
(t -> v -> Maybe String)
-> (v -> String) -> VertexType t -> Vertex v -> Maybe String
validateVertex t -> v -> Maybe String
checkValue v -> String
showValue VertexType t
v296 Vertex v
el)) (VertexLabel
-> Map VertexLabel (VertexType t) -> Maybe (VertexType t)
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup (Vertex v -> VertexLabel
forall v. Vertex v -> VertexLabel
PropertyGraph.vertexLabel Vertex v
el) (GraphSchema t -> Map VertexLabel (VertexType t)
forall t. GraphSchema t -> Map VertexLabel (VertexType t)
PropertyGraph.graphSchemaVertices GraphSchema t
schema)))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll ((Vertex v -> Maybe String) -> [Vertex v] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Vertex v -> Maybe String
checkVertex (Map v (Vertex v) -> [Vertex v]
forall k v. Map k v -> [v]
Maps.values (Graph v -> Map v (Vertex v)
forall v. Graph v -> Map v (Vertex v)
PropertyGraph.graphVertices Graph v
graph))))
checkEdges :: Maybe String
checkEdges =
let checkEdge :: Edge v -> Maybe String
checkEdge = (\Edge v
el -> (\Maybe (EdgeType t)
x -> case Maybe (EdgeType t)
x of
Maybe (EdgeType t)
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just ((v -> String) -> Edge v -> String -> String
forall v. (v -> String) -> Edge v -> String -> String
edgeError v -> String
showValue Edge v
el (String -> String -> String
prepend String
"Unexpected label" (EdgeLabel -> String
PropertyGraph.unEdgeLabel (Edge v -> EdgeLabel
forall v. Edge v -> EdgeLabel
PropertyGraph.edgeLabel Edge v
el)))))
Just EdgeType t
v297 -> ((t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> EdgeType t
-> Edge v
-> Maybe String
forall t v.
(t -> v -> Maybe String)
-> (v -> String)
-> Maybe (v -> Maybe VertexLabel)
-> EdgeType t
-> Edge v
-> Maybe String
validateEdge t -> v -> Maybe String
checkValue v -> String
showValue Maybe (v -> Maybe VertexLabel)
labelForVertexId EdgeType t
v297 Edge v
el)) (EdgeLabel -> Map EdgeLabel (EdgeType t) -> Maybe (EdgeType t)
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup (Edge v -> EdgeLabel
forall v. Edge v -> EdgeLabel
PropertyGraph.edgeLabel Edge v
el) (GraphSchema t -> Map EdgeLabel (EdgeType t)
forall t. GraphSchema t -> Map EdgeLabel (EdgeType t)
PropertyGraph.graphSchemaEdges GraphSchema t
schema)))
labelForVertexId :: Maybe (v -> Maybe VertexLabel)
labelForVertexId = ((v -> Maybe VertexLabel) -> Maybe (v -> Maybe VertexLabel)
forall a. a -> Maybe a
Just (\v
i -> (Vertex v -> VertexLabel) -> Maybe (Vertex v) -> Maybe VertexLabel
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map Vertex v -> VertexLabel
forall v. Vertex v -> VertexLabel
PropertyGraph.vertexLabel (v -> Map v (Vertex v) -> Maybe (Vertex v)
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup v
i (Graph v -> Map v (Vertex v)
forall v. Graph v -> Map v (Vertex v)
PropertyGraph.graphVertices Graph v
graph))))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll ((Edge v -> Maybe String) -> [Edge v] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Edge v -> Maybe String
checkEdge (Map v (Edge v) -> [Edge v]
forall k v. Map k v -> [v]
Maps.values (Graph v -> Map v (Edge v)
forall v. Graph v -> Map v (Edge v)
PropertyGraph.graphEdges Graph v
graph))))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll [
Maybe String
checkVertices,
Maybe String
checkEdges])
validateProperties :: ((t -> v -> Maybe String) -> [PropertyGraph.PropertyType t] -> Map PropertyGraph.PropertyKey v -> Maybe String)
validateProperties :: forall t v.
(t -> v -> Maybe String)
-> [PropertyType t] -> Map PropertyKey v -> Maybe String
validateProperties t -> v -> Maybe String
checkValue [PropertyType t]
types Map PropertyKey v
props =
let checkTypes :: Maybe String
checkTypes = ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll ((PropertyType t -> Maybe String)
-> [PropertyType t] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
Lists.map PropertyType t -> Maybe String
forall {t}. PropertyType t -> Maybe String
checkType [PropertyType t]
types))
checkType :: PropertyType t -> Maybe String
checkType = (\PropertyType t
t -> Maybe String -> Maybe String -> Bool -> Maybe String
forall a. a -> a -> Bool -> a
Logic.ifElse ((\Maybe v
x -> case Maybe v
x of
Maybe v
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String -> String
prepend String
"Missing value for " (PropertyKey -> String
PropertyGraph.unPropertyKey (PropertyType t -> PropertyKey
forall t. PropertyType t -> PropertyKey
PropertyGraph.propertyTypeKey PropertyType t
t))))
Just v
_ -> Maybe String
forall a. Maybe a
Nothing) (PropertyKey -> Map PropertyKey v -> Maybe v
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup (PropertyType t -> PropertyKey
forall t. PropertyType t -> PropertyKey
PropertyGraph.propertyTypeKey PropertyType t
t) Map PropertyKey v
props)) Maybe String
forall a. Maybe a
Nothing (PropertyType t -> Bool
forall t. PropertyType t -> Bool
PropertyGraph.propertyTypeRequired PropertyType t
t))
checkValues :: Maybe String
checkValues =
let m :: Map PropertyKey t
m = ([(PropertyKey, t)] -> Map PropertyKey t
forall k v. Ord k => [(k, v)] -> Map k v
Maps.fromList ((PropertyType t -> (PropertyKey, t))
-> [PropertyType t] -> [(PropertyKey, t)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\PropertyType t
p -> (PropertyType t -> PropertyKey
forall t. PropertyType t -> PropertyKey
PropertyGraph.propertyTypeKey PropertyType t
p, (PropertyType t -> t
forall t. PropertyType t -> t
PropertyGraph.propertyTypeValue PropertyType t
p))) [PropertyType t]
types))
checkPair :: (PropertyKey, v) -> Maybe String
checkPair = (\(PropertyKey, v)
pair ->
let key :: PropertyKey
key = ((PropertyKey, v) -> PropertyKey
forall a b. (a, b) -> a
fst (PropertyKey, v)
pair)
val :: v
val = ((PropertyKey, v) -> v
forall a b. (a, b) -> b
snd (PropertyKey, v)
pair)
in ((\Maybe t
x -> case Maybe t
x of
Maybe t
Nothing -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String -> String
prepend String
"Unexpected key" (PropertyKey -> String
PropertyGraph.unPropertyKey PropertyKey
key)))
Just t
v299 -> ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map (String -> String -> String
prepend String
"Invalid value") (t -> v -> Maybe String
checkValue t
v299 v
val))) (PropertyKey -> Map PropertyKey t -> Maybe t
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup PropertyKey
key Map PropertyKey t
m)))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll (((PropertyKey, v) -> Maybe String)
-> [(PropertyKey, v)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (PropertyKey, v) -> Maybe String
checkPair (Map PropertyKey v -> [(PropertyKey, v)]
forall k v. Map k v -> [(k, v)]
Maps.toList Map PropertyKey v
props)))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll [
Maybe String
checkTypes,
Maybe String
checkValues])
validateVertex :: ((t -> v -> Maybe String) -> (v -> String) -> PropertyGraph.VertexType t -> PropertyGraph.Vertex v -> Maybe String)
validateVertex :: forall t v.
(t -> v -> Maybe String)
-> (v -> String) -> VertexType t -> Vertex v -> Maybe String
validateVertex t -> v -> Maybe String
checkValue v -> String
showValue VertexType t
typ Vertex v
el =
let failWith :: String -> String
failWith = ((v -> String) -> Vertex v -> String -> String
forall v. (v -> String) -> Vertex v -> String -> String
vertexError v -> String
showValue Vertex v
el)
checkLabel :: Maybe String
checkLabel =
let expected :: VertexLabel
expected = (VertexType t -> VertexLabel
forall t. VertexType t -> VertexLabel
PropertyGraph.vertexTypeLabel VertexType t
typ)
actual :: VertexLabel
actual = (Vertex v -> VertexLabel
forall v. Vertex v -> VertexLabel
PropertyGraph.vertexLabel Vertex v
el)
in (Bool -> String -> Maybe String
verify (String -> String -> Bool
Equality.equalString (VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
actual) (VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
expected)) (String -> String
failWith (String -> String -> String
prepend String
"Wrong label" (VertexLabel -> VertexLabel -> String
vertexLabelMismatch VertexLabel
expected VertexLabel
actual))))
checkId :: Maybe String
checkId = ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map (\String
x -> String -> String
failWith (String -> String -> String
prepend String
"Invalid id" String
x)) (t -> v -> Maybe String
checkValue (VertexType t -> t
forall t. VertexType t -> t
PropertyGraph.vertexTypeId VertexType t
typ) (Vertex v -> v
forall v. Vertex v -> v
PropertyGraph.vertexId Vertex v
el)))
checkProperties :: Maybe String
checkProperties = ((String -> String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
Optionals.map (\String
x -> String -> String
failWith (String -> String -> String
prepend String
"Invalid property" String
x)) ((t -> v -> Maybe String)
-> [PropertyType t] -> Map PropertyKey v -> Maybe String
forall t v.
(t -> v -> Maybe String)
-> [PropertyType t] -> Map PropertyKey v -> Maybe String
validateProperties t -> v -> Maybe String
checkValue (VertexType t -> [PropertyType t]
forall t. VertexType t -> [PropertyType t]
PropertyGraph.vertexTypeProperties VertexType t
typ) (Vertex v -> Map PropertyKey v
forall v. Vertex v -> Map PropertyKey v
PropertyGraph.vertexProperties Vertex v
el)))
in ([Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
checkAll [
Maybe String
checkLabel,
Maybe String
checkId,
Maybe String
checkProperties])
checkAll :: ([Maybe a] -> Maybe a)
checkAll :: forall a. [Maybe a] -> Maybe a
checkAll [Maybe a]
checks =
let errors :: [a]
errors = ([Maybe a] -> [a]
forall a. [Maybe a] -> [a]
Optionals.cat [Maybe a]
checks)
in ([a] -> Maybe a
forall a. [a] -> Maybe a
Lists.safeHead [a]
errors)
edgeError :: ((v -> String) -> PropertyGraph.Edge v -> String -> String)
edgeError :: forall v. (v -> String) -> Edge v -> String -> String
edgeError v -> String
showValue Edge v
e = (String -> String -> String
prepend ([String] -> String
Strings.cat [
String
"Invalid edge with id ",
(v -> String
showValue (Edge v -> v
forall v. Edge v -> v
PropertyGraph.edgeId Edge v
e))]))
edgeLabelMismatch :: (PropertyGraph.EdgeLabel -> PropertyGraph.EdgeLabel -> String)
edgeLabelMismatch :: EdgeLabel -> EdgeLabel -> String
edgeLabelMismatch EdgeLabel
expected EdgeLabel
actual = ([String] -> String
Strings.cat [
[String] -> String
Strings.cat [
[String] -> String
Strings.cat [
String
"expected ",
(EdgeLabel -> String
PropertyGraph.unEdgeLabel EdgeLabel
expected)],
String
", found "],
(EdgeLabel -> String
PropertyGraph.unEdgeLabel EdgeLabel
actual)])
prepend :: (String -> String -> String)
prepend :: String -> String -> String
prepend String
prefix String
msg = ([String] -> String
Strings.cat [
[String] -> String
Strings.cat [
String
prefix,
String
": "],
String
msg])
verify :: (Bool -> String -> Maybe String)
verify :: Bool -> String -> Maybe String
verify Bool
b String
err = (Maybe String -> Maybe String -> Bool -> Maybe String
forall a. a -> a -> Bool -> a
Logic.ifElse Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
err) Bool
b)
vertexError :: ((v -> String) -> PropertyGraph.Vertex v -> String -> String)
vertexError :: forall v. (v -> String) -> Vertex v -> String -> String
vertexError v -> String
showValue Vertex v
v = (String -> String -> String
prepend ([String] -> String
Strings.cat [
String
"Invalid vertex with id ",
(v -> String
showValue (Vertex v -> v
forall v. Vertex v -> v
PropertyGraph.vertexId Vertex v
v))]))
vertexLabelMismatch :: (PropertyGraph.VertexLabel -> PropertyGraph.VertexLabel -> String)
vertexLabelMismatch :: VertexLabel -> VertexLabel -> String
vertexLabelMismatch VertexLabel
expected VertexLabel
actual = ([String] -> String
Strings.cat [
[String] -> String
Strings.cat [
[String] -> String
Strings.cat [
String
"expected ",
(VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
expected)],
String
", found "],
(VertexLabel -> String
PropertyGraph.unVertexLabel VertexLabel
actual)])