packages feed

hydra-pg 0.17.2 → 0.17.3

raw patch · 19 files changed

+135/−130 lines, 19 filesdep ~hydra-kerneldep ~hydra-rdfPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hydra-kernel, hydra-rdf

API changes (from Hackage documentation)

Files

hydra-pg.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hydra-pg-version:        0.17.2+version:        0.17.3 synopsis:       Hydra's property-graph (TinkerPop/Gremlin) model and coder support description:    Hydra is an implementation of the LambdaGraph data model, which takes advantage of an isomorphism between labeled hypergraphs and typed lambda calculus: in Hydra, "graphs are programs, and programs are graphs". Property graph support for Hydra category:       Data@@ -77,7 +77,7 @@       base >=4.19.0 && <4.22     , bytestring >=0.11.5 && <0.13     , containers >=0.6.7 && <0.8-    , hydra-kernel ==0.17.2-    , hydra-rdf ==0.17.2+    , hydra-kernel ==0.17.3+    , hydra-rdf ==0.17.3     , scientific >=0.3.7 && <0.4   default-language: Haskell2010
src/main/haskell/Hydra/Cypher/OpenCypher.hs view
@@ -461,7 +461,7 @@  _MultiPartQuery_body = Core.Name "body" --- | A multiplicative expression: a power expression with zero or more */÷/% terms+-- | A multiplicative expression: a power expression with zero or more multiply, divide, or modulo terms data MultiplyDivideModuloExpression =   MultiplyDivideModuloExpression {     multiplyDivideModuloExpressionLeft :: PowerOfExpression,
src/main/haskell/Hydra/Decode/Neo4j/Model.hs view
@@ -40,7 +40,7 @@                       (                         Core.Name "propertyUniqueness",                         (\input -> Eithers.map (\t -> Model.ConstraintPropertyUniqueness t) (propertyUniquenessConstraint cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -73,7 +73,7 @@                     Maps.fromList [                       (Core.Name "node", (\input -> Eithers.map (\t -> Model.ElementNode t) (node cx input))),                       (Core.Name "relationship", (\input -> Eithers.map (\t -> Model.ElementRelationship t) (relationship cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -480,7 +480,7 @@                             _ -> Left (Errors.DecodingError "expected string literal")                           _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))),                       (Core.Name "time", (\input -> Eithers.map (\t -> Model.ValueTime t) (offsetTime cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -514,7 +514,7 @@                       (Core.Name "list", (\input -> Eithers.map (\t -> Model.ValueTypeList t) (valueType cx input))),                       (Core.Name "vector", (\input -> Eithers.map (\t -> Model.ValueTypeVector t) (vectorType cx input))),                       (Core.Name "union", (\input -> Eithers.map (\t -> Model.ValueTypeUnion t) (ExtractCore.decodeList valueType cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))
src/main/haskell/Hydra/Decode/Pg/Mapping.hs view
@@ -132,7 +132,7 @@                     Maps.fromList [                       (Core.Name "vertex", (\input -> Eithers.map (\t -> Mapping.ElementSpecVertex t) (vertexSpec cx input))),                       (Core.Name "edge", (\input -> Eithers.map (\t -> Mapping.ElementSpecEdge t) (edgeSpec cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -167,7 +167,7 @@                             Core.LiteralString v2 -> Right v2                             _ -> Left (Errors.DecodingError "expected string literal")                           _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))
src/main/haskell/Hydra/Decode/Pg/Model.hs view
@@ -47,7 +47,7 @@                       (Core.Name "in", (\input -> Eithers.map (\t -> Model.DirectionIn) (ExtractCore.decodeUnit cx input))),                       (Core.Name "both", (\input -> Eithers.map (\t -> Model.DirectionBoth) (ExtractCore.decodeUnit cx input))),                       (Core.Name "undirected", (\input -> Eithers.map (\t -> Model.DirectionUndirected) (ExtractCore.decodeUnit cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -104,7 +104,7 @@                     Maps.fromList [                       (Core.Name "vertex", (\input -> Eithers.map (\t -> Model.ElementVertex t) (vertex v cx input))),                       (Core.Name "edge", (\input -> Eithers.map (\t -> Model.ElementEdge t) (edge v cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -122,7 +122,7 @@                     Maps.fromList [                       (Core.Name "vertex", (\input -> Eithers.map (\t -> Model.ElementKindVertex) (ExtractCore.decodeUnit cx input))),                       (Core.Name "edge", (\input -> Eithers.map (\t -> Model.ElementKindEdge) (ExtractCore.decodeUnit cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -151,7 +151,7 @@                     Maps.fromList [                       (Core.Name "vertex", (\input -> Eithers.map (\t2 -> Model.ElementTypeVertex t2) (vertexType t cx input))),                       (Core.Name "edge", (\input -> Eithers.map (\t2 -> Model.ElementTypeEdge t2) (edgeType t cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))@@ -202,7 +202,7 @@                     Maps.fromList [                       (Core.Name "vertex", (\input -> Eithers.map (\t -> Model.LabelVertex t) (vertexLabel cx input))),                       (Core.Name "edge", (\input -> Eithers.map (\t -> Model.LabelEdge t) (edgeLabel cx input)))]-        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [+        in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [           "no such field ",           (Core.unName fname),           " in union"]))) (\f -> f fterm))
src/main/haskell/Hydra/Demos/Genpg/Transform.hs view
@@ -67,31 +67,31 @@           decodeValue =                   \value ->                     let parseError =-                            Strings.cat [+                            Strings.concat [                               "Invalid value for column ",                               cname,                               ": ",                               value]                     in case typ of                       Core.TypeLiteral v0 -> case v0 of-                        Core.LiteralTypeBoolean -> Optionals.cases (Literals.readBoolean value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralBoolean parsed))))+                        Core.LiteralTypeBoolean -> Optionals.cases (Literals.parseBoolean value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralBoolean parsed))))                         Core.LiteralTypeFloat v1 -> case v1 of                           Core.FloatTypeFloat32 -> Optionals.cases (Literals.readFloat32 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 parsed)))))                           Core.FloatTypeFloat64 -> Optionals.cases (Literals.readFloat64 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 parsed)))))-                          _ -> Left (Strings.cat [+                          _ -> Left (Strings.concat [                             "Unsupported float type for column ",                             cname])                         Core.LiteralTypeInteger v1 -> case v1 of                           Core.IntegerTypeInt32 -> Optionals.cases (Literals.readInt32 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 parsed)))))                           Core.IntegerTypeInt64 -> Optionals.cases (Literals.readInt64 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 parsed)))))-                          _ -> Left (Strings.cat [+                          _ -> Left (Strings.concat [                             "Unsupported integer type for column ",                             cname])                         Core.LiteralTypeString -> Right (Just (Core.TermLiteral (Core.LiteralString value)))-                        _ -> Left (Strings.cat [+                        _ -> Left (Strings.concat [                           "Unsupported literal type for column ",                           cname])-                      _ -> Left (Strings.cat [+                      _ -> Left (Strings.concat [                         "Unsupported type for column ",                         cname])       in (Optionals.cases mvalue (Right Nothing) decodeValue)@@ -143,14 +143,14 @@                   let table = Pairs.first p                       v = Pairs.second p                       existing = Maps.lookup table m-                      current = Optionals.fromOptional ([], []) existing+                      current = Optionals.withDefault ([], []) existing                   in (Maps.insert table (Lists.cons v (Pairs.first current), (Pairs.second current)) m)             addEdge =                     \m -> \p ->                       let table = Pairs.first p                           e = Pairs.second p                           existing = Maps.lookup table m-                          current = Optionals.fromOptional ([], []) existing+                          current = Optionals.withDefault ([], []) existing                       in (Maps.insert table (Pairs.first current, (Lists.cons e (Pairs.second current))) m)             vertexMap = Lists.foldl addVertex Maps.empty vertexPairs         in (Right (Lists.foldl addEdge vertexMap edgePairs)))))@@ -184,7 +184,7 @@       let extractMaybe =               \k -> \term -> case term of                 Core.TermOptional v0 -> Right (Optionals.map (\v -> (k, v)) v0)-      in (Eithers.map (\pairs -> Maps.fromList (Optionals.cat pairs)) (Eithers.mapList (\pair ->+      in (Eithers.map (\pairs -> Maps.fromList (Optionals.givens pairs)) (Eithers.mapList (\pair ->         let k = Pairs.first pair             spec = Pairs.second pair         in (Eithers.bind (Reduction.reduceTerm cx g True (Core.TermApplication (Core.Application {@@ -238,7 +238,7 @@       let acc = Pairs.first (Pairs.first state)           field = Pairs.second (Pairs.first state)           inQuotes = Pairs.second state-      in (Logic.ifElse (Equality.equal c 34) (Logic.ifElse inQuotes ((acc, field), False) (Logic.ifElse (Strings.null field) ((acc, field), True) ((acc, (Strings.cat2 field "\"")), inQuotes))) (Logic.ifElse (Logic.and (Equality.equal c 44) (Logic.not inQuotes)) ((Lists.cons (normalizeField field) acc, ""), False) ((acc, (Strings.cat2 field (Strings.fromList [+      in (Logic.ifElse (Equality.equal c 34) (Logic.ifElse inQuotes ((acc, field), False) (Logic.ifElse (Strings.null field) ((acc, field), True) ((acc, (Strings.concat2 field "\"")), inQuotes))) (Logic.ifElse (Logic.and (Equality.equal c 44) (Logic.not inQuotes)) ((Lists.cons (normalizeField field) acc, ""), False) ((acc, (Strings.concat2 field (Strings.fromList [         c]))), inQuotes)))  -- | Parse a CSV line into fields. Empty fields become Nothing.@@ -264,12 +264,12 @@ parseTableLines :: Bool -> [String] -> Either String (Tabular.Table String) parseTableLines hasHeader rawLines =     Eithers.bind (Eithers.mapList (\ln -> parseSingleLine ln) rawLines) (\parsedRows ->-      let rows = Optionals.cat parsedRows+      let rows = Optionals.givens parsedRows       in (Logic.ifElse hasHeader (Optionals.cases (Lists.uncons rows) (Left "empty rows: cannot parse header") (\p ->         let headerRow = Pairs.first p             dataRows = Pairs.second p         in (Logic.ifElse (listAny (\m -> Optionals.isNone m) headerRow) (Left "null header column(s)") (Right (Tabular.Table {-          Tabular.tableHeader = (Just (Tabular.HeaderRow (Optionals.cat headerRow))),+          Tabular.tableHeader = (Just (Tabular.HeaderRow (Optionals.givens headerRow))),           Tabular.tableData = (Lists.map (\r -> Tabular.DataRow r) dataRows)}))))) (Right (Tabular.Table {         Tabular.tableHeader = Nothing,         Tabular.tableData = (Lists.map (\r -> Tabular.DataRow r) rows)}))))@@ -298,7 +298,7 @@                     id,                     outId,                     inId] (Maps.elems props))-      in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.cases (Lists.maybeHead (Sets.toList tables)) (Left "unreachable: empty tables set") (\x -> Right x)) (Left (Strings.cat [+      in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.cases (Lists.head (Sets.toList tables)) (Left "unreachable: empty tables set") (\x -> Right x)) (Left (Strings.concat [         "Specification for ",         (PgModel.unEdgeLabel label),         " edges has wrong number of tables"])))@@ -311,7 +311,7 @@           id = PgModel.vertexId vertex           props = PgModel.vertexProperties vertex           tables = findTablesInTerms (Lists.cons id (Maps.elems props))-      in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.cases (Lists.maybeHead (Sets.toList tables)) (Left "unreachable: empty tables set") (\x -> Right x)) (Left (Strings.cat [+      in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.cases (Lists.head (Sets.toList tables)) (Left "unreachable: empty tables set") (\x -> Right x)) (Left (Strings.concat [         "Specification for ",         (PgModel.unVertexLabel label),         " vertices has wrong number of tables"])))@@ -338,7 +338,7 @@ -- | Transform a record through vertex and edge specifications to produce vertices and edges transformRecord :: t0 -> Graph.Graph -> [PgModel.Vertex Core.Term] -> [PgModel.Edge Core.Term] -> Core.Term -> Either Errors.Error ([PgModel.Vertex Core.Term], [PgModel.Edge Core.Term]) transformRecord cx g vspecs especs record =-    Eithers.bind (Eithers.mapList (\spec -> evaluateVertex cx g spec record) vspecs) (\mVertices -> Eithers.bind (Eithers.mapList (\spec -> evaluateEdge cx g spec record) especs) (\mEdges -> Right (Optionals.cat mVertices, (Optionals.cat mEdges))))+    Eithers.bind (Eithers.mapList (\spec -> evaluateVertex cx g spec record) vspecs) (\mVertices -> Eithers.bind (Eithers.mapList (\spec -> evaluateEdge cx g spec record) especs) (\mEdges -> Right (Optionals.givens mVertices, (Optionals.givens mEdges))))  -- | Transform all rows from a table through vertex/edge specifications transformTableRows :: t0 -> Graph.Graph -> [PgModel.Vertex Core.Term] -> [PgModel.Edge Core.Term] -> Tabular.TableType -> [Tabular.DataRow Core.Term] -> Either Errors.Error ([PgModel.Vertex Core.Term], [PgModel.Edge Core.Term])
src/main/haskell/Hydra/Graphviz/Coder.hs view
@@ -118,6 +118,7 @@       (Packaging.ModuleName "hydra.lib.maps", "maps"),       (Packaging.ModuleName "hydra.lib.math", "math"),       (Packaging.ModuleName "hydra.lib.optionals", "optionals"),+      (Packaging.ModuleName "hydra.lib.ordering", "ordering"),       (Packaging.ModuleName "hydra.lib.pairs", "pairs"),       (Packaging.ModuleName "hydra.lib.regex", "regex"),       (Packaging.ModuleName "hydra.lib.sets", "sets"),@@ -134,24 +135,24 @@         Core.TermAnnotated _ -> simpleLabel "@{}"         Core.TermApplication _ -> simpleLabel (Logic.ifElse compact "$" "apply")         Core.TermLambda _ -> simpleLabel (Logic.ifElse compact "\955" "lambda")-        Core.TermProject v0 -> simpleLabel (Strings.cat [+        Core.TermProject v0 -> simpleLabel (Strings.concat [           "{",           (Names.compactName namespaces (Core.projectionTypeName v0)),           "}.",           (Core.unName (Core.projectionFieldName v0))])-        Core.TermCases v0 -> simpleLabel (Strings.cat [+        Core.TermCases v0 -> simpleLabel (Strings.concat [           "cases_{",           (Names.compactName namespaces (Core.caseStatementTypeName v0)),           "}"])-        Core.TermUnwrap v0 -> simpleLabel (Strings.cat [+        Core.TermUnwrap v0 -> simpleLabel (Strings.concat [           "unwrap_{",           (Names.compactName namespaces v0),           "}"])         Core.TermLet _ -> simpleLabel "let"         Core.TermList _ -> simpleLabel (Logic.ifElse compact "[]" "list")         Core.TermLiteral v0 -> simpleLabel (case v0 of-          Core.LiteralBinary v1 -> Literals.binaryToString v1-          Core.LiteralBoolean v1 -> Literals.showBoolean v1+          Core.LiteralBinary v1 -> Literals.binaryToBase64 v1+          Core.LiteralBoolean v1 -> Literals.printBoolean v1           Core.LiteralInteger v1 -> case v1 of             Core.IntegerValueBigint v2 -> Literals.showBigint v2             Core.IntegerValueInt8 v2 -> Literals.showInt8 v2@@ -171,12 +172,12 @@           _ -> "?")         Core.TermMap _ -> simpleLabel (Logic.ifElse compact "<,>" "map")         Core.TermOptional _ -> simpleLabel (Logic.ifElse compact "opt" "optional")-        Core.TermRecord v0 -> simpleLabel (Strings.cat2 "\8743" (Names.compactName namespaces (Core.recordTypeName v0)))+        Core.TermRecord v0 -> simpleLabel (Strings.concat2 "\8743" (Names.compactName namespaces (Core.recordTypeName v0)))         Core.TermTypeLambda _ -> simpleLabel "tyabs"         Core.TermTypeApplication _ -> simpleLabel "tyapp"-        Core.TermInject v0 -> simpleLabel (Strings.cat2 "\8891" (Names.compactName namespaces (Core.injectionTypeName v0)))+        Core.TermInject v0 -> simpleLabel (Strings.concat2 "\8891" (Names.compactName namespaces (Core.injectionTypeName v0)))         Core.TermVariable v0 -> simpleLabel (Names.compactName namespaces v0)-        Core.TermWrap v0 -> simpleLabel (Strings.cat [+        Core.TermWrap v0 -> simpleLabel (Strings.concat [           "(",           (Names.compactName namespaces (Core.wrappedTermTypeName v0)),           ")"])@@ -281,12 +282,12 @@                                 \stVis -> \binding ->                                   let bname = Core.bindingName binding                                       bterm = Core.bindingTerm binding-                                      blab = Dot.unId (Optionals.fromOptional (Dot.Id "?") (Maps.lookup bname ids1))+                                      blab = Dot.unId (Optionals.withDefault (Dot.Id "?") (Maps.lookup bname ids1))                                   in (encode (Just (blab, nodeStyleElement)) True ids1 (Just selfId) stVis (Paths.SubtermStepLetBinding bname, bterm))                         stmts1 = Lists.foldl addBindingTerm (selfStmts, selfVisited) bindings                     in (encode Nothing False ids1 (Just selfId) stmts1 (Paths.SubtermStepLetBody, env))                   Core.TermVariable v0 -> Optionals.cases (Maps.lookup v0 ids) dflt (\i -> (Lists.concat2 stmts [-                    toAccessorEdgeStmt accessor style (Optionals.fromOptional selfId mparent) i], visited))+                    toAccessorEdgeStmt accessor style (Optionals.withDefault selfId mparent) i], visited))                   _ -> dflt       in (Pairs.first (encode Nothing False Maps.empty Nothing ([], Sets.empty) (Paths.SubtermStepAnnotatedBody, term))) @@ -317,7 +318,7 @@                     let lab1 = Paths.subtermNodeId (Paths.subtermEdgeSource edge)                         lab2 = Paths.subtermNodeId (Paths.subtermEdgeTarget edge)                         pathAccessors = Paths.unSubtermPath (Paths.subtermEdgePath edge)-                        showPath = Strings.intercalate "/" (Optionals.cat (Lists.map PrintPaths.subtermStep pathAccessors))+                        showPath = Strings.join "/" (Optionals.givens (Lists.map PrintPaths.subtermStep pathAccessors))                     in (toEdgeStmt (Dot.Id lab1) (Dot.Id lab2) (Just (Dot.AttrList [                       [                         labelAttr showPath]])))
src/main/haskell/Hydra/Graphviz/Serde.hs view
@@ -132,7 +132,7 @@ -- | Convert an identifier to an expression idToExpr :: Dot.Id -> Ast.Expr idToExpr i =-    Serialization.cst (Strings.cat [+    Serialization.cst (Strings.concat [       "\"",       (Dot.unId i),       "\""])@@ -143,7 +143,7 @@        let i = Dot.nodeIdId nid           mp = Dot.nodeIdPort nid-      in (Serialization.noSep (Optionals.cat [+      in (Serialization.noSep (Optionals.givens [         Optionals.pure (idToExpr i),         (Optionals.map portToExpr mp)])) @@ -160,7 +160,7 @@        let i = Dot.nodeStmtId ns           attr = Dot.nodeStmtAttributes ns-      in (Serialization.spaceSep (Optionals.cat [+      in (Serialization.spaceSep (Optionals.givens [         Optionals.pure (nodeIdToExpr i),         (Optionals.map attrListToExpr attr)])) @@ -195,7 +195,7 @@ -- | Convert a subgraph identifier to an expression subgraphIdToExpr :: Dot.SubgraphId -> Ast.Expr subgraphIdToExpr sid =-    Serialization.spaceSep (Optionals.cat [+    Serialization.spaceSep (Optionals.givens [       Optionals.pure (Serialization.cst "subgraph"),       (Optionals.map idToExpr (Dot.unSubgraphId sid))]) @@ -207,6 +207,6 @@           stmts = Dot.subgraphStatements sg           body =                   Serialization.brackets Serialization.curlyBraces Serialization.inlineStyle (Serialization.spaceSep (Lists.map (stmtToExpr directed) stmts))-      in (Serialization.spaceSep (Optionals.cat [+      in (Serialization.spaceSep (Optionals.givens [         Optionals.map subgraphIdToExpr mid,         (Optionals.pure body)]))
src/main/haskell/Hydra/Neo4j/Pg.hs view
@@ -12,6 +12,7 @@ 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.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings@@ -32,11 +33,11 @@           startStr = Neo4jModel.unNodeLabel startLabel           endStr = Neo4jModel.unNodeLabel endLabel           expanded =-                  Strings.cat [+                  Strings.concat [                     Formatting.decapitalize (Formatting.convertCase Util.CaseConventionPascal Util.CaseConventionCamel startStr),                     (Formatting.capitalize camelType),                     (Formatting.capitalize (Formatting.convertCase Util.CaseConventionPascal Util.CaseConventionCamel endStr))]-      in (PgModel.EdgeLabel (Logic.ifElse (Equality.gt (Lists.length matching) 1) expanded camelType))+      in (PgModel.EdgeLabel (Logic.ifElse (Ordering.gt (Lists.length matching) 1) expanded camelType))  -- | Convert a property-graph edge to a Neo4j relationship (edge label -> UPPER_SNAKE type). edgeToRelationship :: Neo4jModel.Neo4jMapping t0 -> PgModel.Edge t0 -> Either String Neo4jModel.Relationship@@ -61,9 +62,9 @@               (\nodes2 -> \eid ->                 let m =                         Maps.fromList (Lists.map (\n -> (Neo4jModel.unElementId (Neo4jModel.nodeId n), (Sets.toList (Neo4jModel.nodeLabels n)))) nodes2)-                in (Optionals.cases (Maps.lookup (Neo4jModel.unElementId eid) m) (Left (Strings.cat [+                in (Optionals.cases (Maps.lookup (Neo4jModel.unElementId eid) m) (Left (Strings.concat [                   "no node with id ",-                  (Neo4jModel.unElementId eid)])) (\labels -> Logic.ifElse (Equality.equal (Lists.length labels) 1) (Right (Optionals.fromOptional (Neo4jModel.NodeLabel "") (Lists.maybeHead labels))) (Left (Strings.cat [+                  (Neo4jModel.unElementId eid)])) (\labels -> Logic.ifElse (Equality.equal (Lists.length labels) 1) (Right (Optionals.withDefault (Neo4jModel.NodeLabel "") (Lists.head labels))) (Left (Strings.concat [                   "endpoint node is not single-labeled: ",                   (Neo4jModel.unElementId eid)]))))) nodes       in (Eithers.bind (Eithers.mapList (\n -> nodeToVertex mapping n) nodes) (\vertices -> Eithers.bind (Eithers.mapList (\r -> Eithers.bind (labelOf (Neo4jModel.relationshipStart r)) (\startLabel -> Eithers.bind (labelOf (Neo4jModel.relationshipEnd r)) (\endLabel -> relationshipToEdge mapping gt startLabel endLabel r))) rels) (\edges -> Right (vertices, edges))))@@ -73,11 +74,11 @@ nodeToVertex mapping node =        let labels = Sets.toList (Neo4jModel.nodeLabels node)-          soleLabel = Optionals.fromOptional (Neo4jModel.NodeLabel "") (Lists.maybeHead labels)+          soleLabel = Optionals.withDefault (Neo4jModel.NodeLabel "") (Lists.head labels)       in (Logic.ifElse (Equality.equal (Lists.length labels) 1) (Eithers.bind (Neo4jModel.neo4jMappingDecodeId mapping (Neo4jModel.nodeId node)) (\vid -> Eithers.bind ((\mapping2 -> \props -> Eithers.map (\pairs -> Maps.fromList pairs) (Eithers.mapList (\entry -> Eithers.map (\decoded -> (PgModel.PropertyKey (Neo4jModel.unKey (Pairs.first entry)), decoded)) (Neo4jModel.neo4jMappingDecodeValue mapping2 (Pairs.second entry))) (Maps.toList props))) mapping (Neo4jModel.nodeProperties node)) (\props -> Right (PgModel.Vertex {         PgModel.vertexLabel = (PgModel.VertexLabel (Neo4jModel.unNodeLabel soleLabel)),         PgModel.vertexId = vid,-        PgModel.vertexProperties = props})))) (Left (Strings.cat [+        PgModel.vertexProperties = props})))) (Left (Strings.concat [         "cannot map a multi-label Neo4j node to a single-label property-graph vertex: ",         (Neo4jModel.unElementId (Neo4jModel.nodeId node))])))
src/main/haskell/Hydra/Pg/Coder.hs view
@@ -25,6 +25,7 @@ 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.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings@@ -60,7 +61,7 @@ -- | Check that a record name matches the expected name checkRecordName :: t0 -> Core.Name -> Core.Name -> Either Errors.Error () checkRecordName cx expected actual =-    check cx (Logic.or (Equality.equal (Core.unName expected) "placeholder") (Equality.equal (Core.unName actual) (Core.unName expected))) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 (Strings.cat2 "Expected record of type " (Core.unName expected)) ", found record of type ") (Core.unName actual)))))+    check cx (Logic.or (Equality.equal (Core.unName expected) "placeholder") (Equality.equal (Core.unName actual) (Core.unName expected))) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 (Strings.concat2 "Expected record of type " (Core.unName expected)) ", found record of type ") (Core.unName actual)))))  -- | Construct an edge coder from components constructEdgeCoder :: t0 -> Graph.Graph -> PgModel.VertexLabel -> Mapping.Schema t1 t2 t3 Errors.Error -> Core.Type -> t2 -> t2 -> PgModel.Direction -> Core.Name -> [Core.FieldType] -> [Coders.Adapter Core.FieldType (PgModel.PropertyType t2) Core.Field (PgModel.Property t3) Errors.Error] -> Maybe (Core.FieldType, (Mapping.ValueSpec, (Maybe String))) -> Maybe (Core.FieldType, (Mapping.ValueSpec, (Maybe String))) -> Either Errors.Error (Coders.Adapter Core.Type (PgModel.ElementTypeTree t2) Core.Term (PgModel.ElementTree t3) Errors.Error)@@ -70,7 +71,7 @@           vertexIdsSchema = Mapping.schemaVertexIds schema       in (Eithers.bind (edgeIdAdapter cx g schema eidType name (Core.Name (Mapping.annotationSchemaEdgeId (Mapping.schemaAnnotations schema))) fields) (\idAdapter -> Eithers.bind (Optionals.cases mOutSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (projectionAdapter cx g vidType vertexIdsSchema s "out"))) (\outIdAdapter -> Eithers.bind (Optionals.cases mInSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (projectionAdapter cx g vidType vertexIdsSchema s "in"))) (\inIdAdapter -> Eithers.bind (Optionals.cases mOutSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (findIncidentVertexAdapter cx g schema vidType eidType s))) (\outVertexAdapter -> Eithers.bind (Optionals.cases mInSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (findIncidentVertexAdapter cx g schema vidType eidType s))) (\inVertexAdapter ->         let vertexAdapters =-                Optionals.cat [+                Optionals.givens [                   outVertexAdapter,                   inVertexAdapter]         in (Eithers.bind (Optionals.cases mOutSpec (Right parentLabel) (\spec -> Optionals.cases (Pairs.second (Pairs.second spec)) (Left (Errors.ErrorOther (Errors.OtherError "no out-vertex label"))) (\a -> Right (PgModel.VertexLabel a)))) (\outLabel -> Eithers.bind (Optionals.cases mInSpec (Right parentLabel) (\spec -> Optionals.cases (Pairs.second (Pairs.second spec)) (Left (Errors.ErrorOther (Errors.OtherError "no in-vertex label"))) (\a -> Right (PgModel.VertexLabel a)))) (\inLabel -> Right (edgeCoder cx g dir schema source eidType name label outLabel inLabel idAdapter outIdAdapter inIdAdapter propAdapters vertexAdapters)))))))))))@@ -102,7 +103,7 @@             let deannot = Strip.deannotateTerm term                 unwrapped =                         case deannot of-                          Core.TermOptional v0 -> Optionals.fromOptional deannot v0+                          Core.TermOptional v0 -> Optionals.withDefault deannot v0                           _ -> deannot                 rec =                         case unwrapped of@@ -112,7 +113,7 @@               in (Eithers.bind (Optionals.cases mIdAdapter (Right (Mapping.schemaDefaultEdgeId schema)) (selectEdgeId cx fieldsm)) (\edgeId -> Eithers.bind (encodeProperties cx fieldsm propAdapters) (\props ->                 let getVertexId =                         \dirCheck -> \adapter -> Optionals.cases (Logic.ifElse (Equality.equal dir dirCheck) Nothing adapter) (Right (Mapping.schemaDefaultVertexId schema)) (selectVertexId cx fieldsm)-                in (Eithers.bind (getVertexId PgModel.DirectionOut outAdapter) (\outId -> Eithers.bind (getVertexId PgModel.DirectionIn inAdapter) (\inId -> Eithers.bind (Eithers.map (\xs -> Optionals.cat xs) (Eithers.mapList (\va ->+                in (Eithers.bind (getVertexId PgModel.DirectionOut outAdapter) (\outId -> Eithers.bind (getVertexId PgModel.DirectionIn inAdapter) (\inId -> Eithers.bind (Eithers.map (\xs -> Optionals.givens xs) (Eithers.mapList (\va ->                   let fname = Pairs.first va                       ad = Pairs.second va                   in (Optionals.cases (Maps.lookup fname fieldsm) (Right Nothing) (\fterm -> Eithers.map (\x -> Just x) (Coders.coderEncode (Coders.adapterCoder ad) fterm)))) vertexAdapters)) (\deps -> Right (elementTreeEdge (PgModel.Edge {@@ -147,7 +148,7 @@             in (Eithers.bind (findPropertySpecs cx g schema kind v0) (\propSpecs -> Eithers.bind (Eithers.mapList (propertyAdapter cx g schema) propSpecs) (\propAdapters -> case kind of               PgModel.ElementKindVertex -> constructVertexCoder cx g schema source vidType eidType name v0 propAdapters               PgModel.ElementKindEdge -> constructEdgeCoder cx g parentLabel schema source vidType eidType dir name v0 propAdapters mOutSpec mInSpec))))))-        _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 (Strings.cat2 "Expected " "record type") ", found: ") "other type")))+        _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 (Strings.concat2 "Expected " "record type") ", found: ") "other type")))  -- | Create an element tree for an edge elementTreeEdge :: PgModel.Edge t0 -> [PgModel.ElementTree t0] -> PgModel.ElementTree t0@@ -180,7 +181,7 @@ -- | Encode all properties from a field map using property adapters encodeProperties :: t0 -> M.Map Core.Name Core.Term -> [Coders.Adapter Core.FieldType t1 Core.Field (PgModel.Property t2) Errors.Error] -> Either Errors.Error (M.Map PgModel.PropertyKey t2) encodeProperties cx fields adapters =-    Eithers.map (\props -> Maps.fromList (Lists.map (\prop -> (PgModel.propertyKey prop, (PgModel.propertyValue prop))) props)) (Eithers.map (\xs -> Optionals.cat xs) (Eithers.mapList (encodeProperty cx fields) adapters))+    Eithers.map (\props -> Maps.fromList (Lists.map (\prop -> (PgModel.propertyKey prop, (PgModel.propertyValue prop))) props)) (Eithers.map (\xs -> Optionals.givens xs) (Eithers.mapList (encodeProperty cx fields) adapters))  -- | Encode a single property from a field map using a property adapter encodeProperty :: t0 -> M.Map Core.Name Core.Term -> Coders.Adapter Core.FieldType t1 Core.Field t2 Errors.Error -> Either Errors.Error (Maybe t2)@@ -196,7 +197,7 @@                   \v -> Eithers.map (\x -> Just x) (Coders.coderEncode (Coders.adapterCoder adapter) (Core.Field {                     Core.fieldName = fname,                     Core.fieldTerm = v}))-      in (Optionals.cases (Maps.lookup fname fields) (Logic.ifElse isMaybe (Right Nothing) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "expected field not found in record: " (Core.unName fname)))))) (\value -> Logic.ifElse isMaybe (case (Strip.deannotateTerm value) of+      in (Optionals.cases (Maps.lookup fname fields) (Logic.ifElse isMaybe (Right Nothing) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "expected field not found in record: " (Core.unName fname)))))) (\value -> Logic.ifElse isMaybe (case (Strip.deannotateTerm value) of         Core.TermOptional v0 -> Optionals.cases v0 (Right Nothing) encodeValue         _ -> encodeValue value) (encodeValue value))) @@ -211,7 +212,7 @@     Core.FieldType,     (PgModel.EdgeLabel, (Coders.Adapter Core.Type (PgModel.ElementTypeTree t2) Core.Term (PgModel.ElementTree t3) Errors.Error))))] findAdjacenEdgeAdapters cx g schema vidType eidType parentLabel dir fields =-    Eithers.map (\xs -> Optionals.cat xs) (Eithers.mapList (\field ->+    Eithers.map (\xs -> Optionals.givens xs) (Eithers.mapList (\field ->       let key =               Core.Name (case dir of                 PgModel.DirectionOut -> Mapping.annotationSchemaOutEdgeLabel (Mapping.schemaAnnotations schema)@@ -221,7 +222,7 @@ -- | Find an id projection spec for a field findIdProjectionSpec :: t0 -> Bool -> Core.Name -> Core.Name -> [Core.FieldType] -> Either Errors.Error (Maybe (Core.FieldType, (Mapping.ValueSpec, (Maybe String)))) findIdProjectionSpec cx required tname idKey fields =-    Eithers.bind (findSingleFieldWithAnnotationKey cx tname idKey fields) (\mid -> Optionals.cases mid (Logic.ifElse required (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 "no " (Core.unName idKey)) " field")))) (Right Nothing)) (\mi -> Eithers.map (\spec -> Just (mi, (spec, (Optionals.map (\s -> Strings.toUpper s) Nothing)))) (Optionals.cases (Annotations.getTypeAnnotation idKey (Core.fieldTypeType mi)) (Right Mapping.ValueSpecValue) (TermsToElements.decodeValueSpec cx (Graph.Graph {+    Eithers.bind (findSingleFieldWithAnnotationKey cx tname idKey fields) (\mid -> Optionals.cases mid (Logic.ifElse required (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "no " (Core.unName idKey)) " field")))) (Right Nothing)) (\mi -> Eithers.map (\spec -> Just (mi, (spec, (Optionals.map (\s -> Strings.toUpper s) Nothing)))) (Optionals.cases (Annotations.getTypeAnnotation idKey (Core.fieldTypeType mi)) (Right Mapping.ValueSpecValue) (TermsToElements.decodeValueSpec cx (Graph.Graph {       Graph.graphBoundTerms = Maps.empty,       Graph.graphBoundTypes = Maps.empty,       Graph.graphClassConstraints = Maps.empty,@@ -282,7 +283,7 @@ findSingleFieldWithAnnotationKey cx tname key fields =        let matches = Lists.filter (\f -> Optionals.isGiven (Annotations.getTypeAnnotation key (Core.fieldTypeType f))) fields-      in (Logic.ifElse (Equality.gt (Lists.length matches) 1) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 (Strings.cat2 "Multiple fields marked as '" (Core.unName key)) "' in record type ") (Core.unName tname))))) (Right (Lists.maybeHead matches)))+      in (Logic.ifElse (Ordering.gt (Lists.length matches) 1) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 (Strings.concat2 "Multiple fields marked as '" (Core.unName key)) "' in record type ") (Core.unName tname))))) (Right (Lists.head matches)))  -- | Determine whether the spec has vertex adapters based on direction and out/in specs hasVertexAdapters :: PgModel.Direction -> Maybe t0 -> Maybe t1 -> Bool@@ -305,8 +306,8 @@           Coders.adapterSource = (Core.fieldTypeType field),           Coders.adapterTarget = idtype,           Coders.adapterCoder = Coders.Coder {-            Coders.coderEncode = (\typ -> Eithers.bind (traverseToSingleTerm cx (Strings.cat2 key "-projection") (traversal cx) typ) (\t -> Coders.coderEncode coder t)),-            Coders.coderDecode = (\_ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 "edge '" key) "' decoding is not yet supported"))))}})))+            Coders.coderEncode = (\typ -> Eithers.bind (traverseToSingleTerm cx (Strings.concat2 key "-projection") (traversal cx) typ) (\t -> Coders.coderEncode coder t)),+            Coders.coderDecode = (\_ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "edge '" key) "' decoding is not yet supported"))))}})))  -- | Create a property adapter from a property spec propertyAdapter :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> (Core.FieldType, (Mapping.ValueSpec, (Maybe String))) -> Either Errors.Error (Coders.Adapter Core.FieldType (PgModel.PropertyType t3) Core.Field (PgModel.Property t4) Errors.Error)@@ -315,7 +316,7 @@       let tfield = Pairs.first spec           values = Pairs.first (Pairs.second spec)           alias = Pairs.second (Pairs.second spec)-          key = PgModel.PropertyKey (Optionals.fromOptional (Core.unName (Core.fieldTypeName tfield)) alias)+          key = PgModel.PropertyKey (Optionals.withDefault (Core.unName (Core.fieldTypeName tfield)) alias)       in (Eithers.bind (Coders.coderEncode (Mapping.schemaPropertyTypes schema) (Core.fieldTypeType tfield)) (\pt -> Eithers.bind (TermsToElements.parseValueSpec cx g values) (\traversal -> Right (Coders.Adapter {         Coders.adapterIsLossy = True,         Coders.adapterSource = tfield,@@ -343,7 +344,7 @@        let fname = Pairs.first ad           adapter = Pairs.second ad-      in (Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))+      in (Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))  -- | Select a vertex id from record fields using an id adapter selectVertexId :: t0 -> M.Map Core.Name t1 -> (Core.Name, (Coders.Adapter t2 t3 t1 t4 Errors.Error)) -> Either Errors.Error t4@@ -351,12 +352,12 @@        let fname = Pairs.first ad           adapter = Pairs.second ad-      in (Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 (Strings.cat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))+      in (Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))  -- | Traverse to a single term, failing if zero or multiple terms are found traverseToSingleTerm :: t0 -> String -> (t1 -> Either Errors.Error [t2]) -> t1 -> Either Errors.Error t2 traverseToSingleTerm cx desc traversal term =-    Eithers.bind (traversal term) (\terms -> Logic.ifElse (Lists.null terms) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 desc " did not resolve to a term")))) (Logic.ifElse (Equality.equal (Lists.length terms) 1) (Optionals.cases (Lists.maybeHead terms) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 desc " resolved to multiple terms")))) (\x -> Right x)) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 desc " resolved to multiple terms"))))))+    Eithers.bind (traversal term) (\terms -> Logic.ifElse (Lists.null terms) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 desc " did not resolve to a term")))) (Logic.ifElse (Equality.equal (Lists.length terms) 1) (Optionals.cases (Lists.head terms) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 desc " resolved to multiple terms")))) (\x -> Right x)) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 desc " resolved to multiple terms"))))))  -- | Create a vertex coder given all components vertexCoder :: t0 -> t1 -> Mapping.Schema t2 t3 t4 t5 -> t6 -> t7 -> t8 -> PgModel.VertexLabel -> (Core.Name, (Coders.Adapter t9 t10 Core.Term t4 Errors.Error)) -> [Coders.Adapter Core.FieldType (PgModel.PropertyType t7) Core.Field (PgModel.Property t4) Errors.Error] -> [(@@ -382,7 +383,7 @@             let deannot = Strip.deannotateTerm term                 unwrapped =                         case deannot of-                          Core.TermOptional v0 -> Optionals.fromOptional deannot v0+                          Core.TermOptional v0 -> Optionals.withDefault deannot v0                           _ -> deannot                 rec =                         case unwrapped of
src/main/haskell/Hydra/Pg/Graphson/Coder.hs view
@@ -92,7 +92,7 @@ -- | Create a JSON object from a list of key-value pairs, filtering out Nothing values toJsonObject :: [(String, (Maybe Model.Value))] -> Model.Value toJsonObject pairs =-    Model.ValueObject (Optionals.cat (Lists.map (\p -> Optionals.map (\v -> (Pairs.first p, v)) (Pairs.second p)) pairs))+    Model.ValueObject (Optionals.givens (Lists.map (\p -> Optionals.map (\v -> (Pairs.first p, v)) (Pairs.second p)) pairs))  -- | Create a typed JSON object with @type and @value fields typedValueToJson :: String -> Model.Value -> Model.Value
src/main/haskell/Hydra/Pg/Graphson/Utils.hs view
@@ -102,7 +102,7 @@ encodeTermValue term =     case (Strip.deannotateTerm term) of       Core.TermLiteral v0 -> case v0 of-        Core.LiteralBinary v1 -> Right (Syntax.ValueBinary (Literals.binaryToString v1))+        Core.LiteralBinary v1 -> Right (Syntax.ValueBinary (Literals.binaryToBase64 v1))         Core.LiteralBoolean v1 -> Right (Syntax.ValueBoolean v1)         Core.LiteralFloat v1 -> case v1 of           Core.FloatValueFloat32 v2 -> Right (Syntax.ValueFloat (Syntax.FloatValueFinite v2))
src/main/haskell/Hydra/Pg/Printing.hs view
@@ -50,8 +50,8 @@           outId = printValue (PgModel.edgeOut edge)           inId = printValue (PgModel.edgeIn edge)           props =-                  Strings.intercalate ", " (Lists.map (\p -> printProperty printValue (Pairs.first p) (Pairs.second p)) (Maps.toList (PgModel.edgeProperties edge)))-      in (Strings.cat [+                  Strings.join ", " (Lists.map (\p -> printProperty printValue (Pairs.first p) (Pairs.second p)) (Maps.toList (PgModel.edgeProperties edge)))+      in (Strings.concat [         id,         ": ",         "(",@@ -77,20 +77,20 @@        let vertices = PgModel.lazyGraphVertices lg           edges = PgModel.lazyGraphEdges lg-      in (Strings.cat [+      in (Strings.concat [         "vertices:",-        (Strings.cat (Lists.map (\v -> Strings.cat [+        (Strings.concat (Lists.map (\v -> Strings.concat [           "\n\t",           (printVertex printValue v)]) vertices)),         "\nedges:",-        (Strings.cat (Lists.map (\e -> Strings.cat [+        (Strings.concat (Lists.map (\e -> Strings.concat [           "\n\t",           (printEdge printValue e)]) edges))])  -- | Print a property using the provided value printer printProperty :: (t0 -> String) -> PgModel.PropertyKey -> t0 -> String printProperty printValue key value =-    Strings.cat [+    Strings.concat [       PgModel.unPropertyKey key,       ": ",       (printValue value)]@@ -102,8 +102,8 @@       let label = PgModel.unVertexLabel (PgModel.vertexLabel vertex)           id = printValue (PgModel.vertexId vertex)           props =-                  Strings.intercalate ", " (Lists.map (\p -> printProperty printValue (Pairs.first p) (Pairs.second p)) (Maps.toList (PgModel.vertexProperties vertex)))-      in (Strings.cat [+                  Strings.join ", " (Lists.map (\p -> printProperty printValue (Pairs.first p) (Pairs.second p)) (Maps.toList (PgModel.vertexProperties vertex)))+      in (Strings.concat [         id,         ": (",         label,
src/main/haskell/Hydra/Pg/TermsToElements.hs view
@@ -60,7 +60,7 @@       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))) [+      in (Lists.concat (Lists.map (\pStr -> Lists.map (\a -> Strings.concat2 (Strings.concat2 a pStr) litP) accum) pStrs))) [       firstLit] evaluated))))  -- | Decode an edge label from a term@@ -133,11 +133,11 @@       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 [+      Core.TermRecord v0 -> Optionals.cases (Maps.lookup (Core.Name step) (Resolution.fieldMap (Core.recordFields v0))) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "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))))+      _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "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]@@ -179,13 +179,13 @@ parsePattern cx _g pat =        let segments = Strings.splitOn "${" pat-          firstLit = Optionals.fromOptional pat (Lists.maybeHead segments)+          firstLit = Optionals.withDefault pat (Lists.head 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)+                        pathStr = Optionals.withDefault "" (Lists.head parts)+                        litPart = Strings.join "}" (Lists.drop 1 parts)                         pathSteps = Strings.splitOn "/" pathStr                     in (pathSteps, litPart)) rest       in (Right (\cx_ -> \term -> applyPattern cx_ firstLit parsed term))@@ -229,18 +229,18 @@ -- | 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+    Optionals.cases (Maps.lookup fname fields) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "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 ->+      in (Optionals.cases (Lists.head 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 ->+        in (Optionals.cases (Lists.head matching) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "unexpected field: " (Core.unName key))))) (\m ->           let handler = Pairs.second m           in (handler val)))))) @@ -252,7 +252,7 @@ -- | 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))))))+    Eithers.bind (fun term) (\results -> Logic.ifElse (Lists.null results) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "No value found: " context)))) (Logic.ifElse (Equality.equal (Lists.length results) 1) (Optionals.cases (Lists.head results) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "Multiple values found: " context)))) (\x -> Right x)) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "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)@@ -266,7 +266,7 @@         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)+        let labels = Lists.distinct (Lists.map (\_p -> Pairs.first _p) specs)             encoders = Lists.map (\_p -> Pairs.second _p) specs         in (Right (Coders.Adapter {           Coders.adapterIsLossy = False,
src/main/haskell/Hydra/Pg/Utils.hs view
@@ -118,7 +118,7 @@     (\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 [+        in (Eithers.map (\propsJson -> JsonModel.ValueObject (Optionals.givens [           Just ("label", labelJson),           (Just ("id", (JsonModel.ValueString (PrintCore.term term)))),           propsJson])) ((\pairs -> Logic.ifElse (Maps.null pairs) (Right Nothing) (Eithers.map (\p -> Just ("properties", (JsonModel.ValueObject p))) (Eithers.mapList (\pair ->@@ -127,7 +127,7 @@           in (Eithers.bind (Coders.coderDecode (Mapping.schemaPropertyValues schema) v) (\term2 -> Right (PgModel.unPropertyKey key, (JsonModel.ValueString (PrintCore.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 [+        in (Eithers.map (\propsJson -> JsonModel.ValueObject (Optionals.givens [           Just ("label", labelJson),           (Just ("id", (JsonModel.ValueString (PrintCore.term term)))),           (Just ("out", (JsonModel.ValueString (PrintCore.term termOut)))),
src/main/haskell/Hydra/Print/Error/Pg.hs view
@@ -43,18 +43,18 @@ invalidEdgeError :: Pg.InvalidEdgeError -> String invalidEdgeError e =     case e of-      Pg.InvalidEdgeErrorId v0 -> Strings.cat2 "invalid id: " (invalidValueError v0)-      Pg.InvalidEdgeErrorInVertexLabel v0 -> Strings.cat2 "wrong in-vertex label: " (wrongVertexLabelError v0)+      Pg.InvalidEdgeErrorId v0 -> Strings.concat2 "invalid id: " (invalidValueError v0)+      Pg.InvalidEdgeErrorInVertexLabel v0 -> Strings.concat2 "wrong in-vertex label: " (wrongVertexLabelError v0)       Pg.InvalidEdgeErrorInVertexNotFound -> "in-vertex not found"       Pg.InvalidEdgeErrorLabel v0 -> noSuchEdgeLabelError v0-      Pg.InvalidEdgeErrorOutVertexLabel v0 -> Strings.cat2 "wrong out-vertex label: " (wrongVertexLabelError v0)+      Pg.InvalidEdgeErrorOutVertexLabel v0 -> Strings.concat2 "wrong out-vertex label: " (wrongVertexLabelError v0)       Pg.InvalidEdgeErrorOutVertexNotFound -> "out-vertex not found"       Pg.InvalidEdgeErrorProperty v0 -> invalidElementPropertyError v0  -- | Show an invalid element property error as a string invalidElementPropertyError :: Pg.InvalidElementPropertyError -> String invalidElementPropertyError e =-    Strings.cat [+    Strings.concat [       "property ",       (PgModel.unPropertyKey (Pg.invalidElementPropertyErrorKey e)),       ": ",@@ -63,7 +63,7 @@ -- | Show an invalid graph edge error as a string, given a value printer invalidGraphEdgeError :: (t0 -> String) -> Pg.InvalidGraphEdgeError t0 -> String invalidGraphEdgeError printValue e =-    Strings.cat [+    Strings.concat [       "edge ",       (printValue (Pg.invalidGraphEdgeErrorId e)),       ": ",@@ -79,7 +79,7 @@ -- | Show an invalid graph vertex error as a string, given a value printer invalidGraphVertexError :: (t0 -> String) -> Pg.InvalidGraphVertexError t0 -> String invalidGraphVertexError printValue e =-    Strings.cat [+    Strings.concat [       "vertex ",       (printValue (Pg.invalidGraphVertexErrorId e)),       ": ",@@ -89,14 +89,14 @@ invalidPropertyError :: Pg.InvalidPropertyError -> String invalidPropertyError e =     case e of-      Pg.InvalidPropertyErrorInvalidValue v0 -> Strings.cat2 "invalid value: " (invalidValueError v0)-      Pg.InvalidPropertyErrorMissingRequired v0 -> Strings.cat2 "missing required property: " (PgModel.unPropertyKey v0)-      Pg.InvalidPropertyErrorUnexpectedKey v0 -> Strings.cat2 "unexpected property key: " (PgModel.unPropertyKey v0)+      Pg.InvalidPropertyErrorInvalidValue v0 -> Strings.concat2 "invalid value: " (invalidValueError v0)+      Pg.InvalidPropertyErrorMissingRequired v0 -> Strings.concat2 "missing required property: " (PgModel.unPropertyKey v0)+      Pg.InvalidPropertyErrorUnexpectedKey v0 -> Strings.concat2 "unexpected property key: " (PgModel.unPropertyKey v0)  -- | Show an invalid value error as a string invalidValueError :: Pg.InvalidValueError -> String invalidValueError e =-    Strings.cat [+    Strings.concat [       "expected ",       (Pg.invalidValueErrorExpectedType e),       ", got ",@@ -106,28 +106,28 @@ invalidVertexError :: Pg.InvalidVertexError -> String invalidVertexError e =     case e of-      Pg.InvalidVertexErrorId v0 -> Strings.cat2 "invalid id: " (invalidValueError v0)+      Pg.InvalidVertexErrorId v0 -> Strings.concat2 "invalid id: " (invalidValueError v0)       Pg.InvalidVertexErrorLabel v0 -> noSuchVertexLabelError v0       Pg.InvalidVertexErrorProperty v0 -> invalidElementPropertyError v0  -- | Show a no-such-edge-label error as a string noSuchEdgeLabelError :: Pg.NoSuchEdgeLabelError -> String noSuchEdgeLabelError e =-    Strings.cat [+    Strings.concat [       "no such edge label: ",       (PgModel.unEdgeLabel (Pg.noSuchEdgeLabelErrorLabel e))]  -- | Show a no-such-vertex-label error as a string noSuchVertexLabelError :: Pg.NoSuchVertexLabelError -> String noSuchVertexLabelError e =-    Strings.cat [+    Strings.concat [       "no such vertex label: ",       (PgModel.unVertexLabel (Pg.noSuchVertexLabelErrorLabel e))]  -- | Show a wrong-vertex-label error as a string wrongVertexLabelError :: Pg.WrongVertexLabelError -> String wrongVertexLabelError e =-    Strings.cat [+    Strings.concat [       "expected vertex label ",       (PgModel.unVertexLabel (Pg.wrongVertexLabelErrorExpected e)),       ", got ",
src/main/haskell/Hydra/Tinkerpop/Language.hs view
@@ -53,28 +53,28 @@           supportsLiterals = True           supportsMaps = Features.dataTypeFeaturesSupportsMapValues vpFeatures           literalVariants =-                  Sets.fromList (Optionals.cat [+                  Sets.fromList (Optionals.givens [                     cond Variants.LiteralVariantBinary (Features.dataTypeFeaturesSupportsByteArrayValues vpFeatures),                     (cond Variants.LiteralVariantBoolean (Features.dataTypeFeaturesSupportsBooleanValues vpFeatures)),                     (cond Variants.LiteralVariantFloat (Logic.or (Features.dataTypeFeaturesSupportsFloatValues vpFeatures) (Features.dataTypeFeaturesSupportsDoubleValues vpFeatures))),                     (cond Variants.LiteralVariantInteger (Logic.or (Features.dataTypeFeaturesSupportsIntegerValues vpFeatures) (Features.dataTypeFeaturesSupportsLongValues vpFeatures))),                     (cond Variants.LiteralVariantString (Features.dataTypeFeaturesSupportsStringValues vpFeatures))])           floatTypes =-                  Sets.fromList (Optionals.cat [+                  Sets.fromList (Optionals.givens [                     cond Core.FloatTypeFloat32 (Features.dataTypeFeaturesSupportsFloatValues vpFeatures),                     (cond Core.FloatTypeFloat64 (Features.dataTypeFeaturesSupportsDoubleValues vpFeatures))])           integerTypes =-                  Sets.fromList (Optionals.cat [+                  Sets.fromList (Optionals.givens [                     cond Core.IntegerTypeInt32 (Features.dataTypeFeaturesSupportsIntegerValues vpFeatures),                     (cond Core.IntegerTypeInt64 (Features.dataTypeFeaturesSupportsLongValues vpFeatures))])           termVariants =-                  Sets.fromList (Optionals.cat [+                  Sets.fromList (Optionals.givens [                     cond Variants.TermVariantList supportsLists,                     (cond Variants.TermVariantLiteral supportsLiterals),                     (cond Variants.TermVariantMap supportsMaps),                     (Optionals.pure Variants.TermVariantOptional)])           typeVariants =-                  Sets.fromList (Optionals.cat [+                  Sets.fromList (Optionals.givens [                     cond Variants.TypeVariantList supportsLists,                     (cond Variants.TypeVariantLiteral supportsLiterals),                     (cond Variants.TypeVariantMap supportsMaps),
src/main/haskell/Hydra/Validate/Neo4j.hs view
@@ -11,6 +11,7 @@ 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.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Neo4j.Model as Model@@ -46,9 +47,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -60,9 +61,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -210,7 +211,7 @@                         Neo4j.propertyTypeErrorExpectedType = (Model.propertyTypeConstraintType v0),                         Neo4j.propertyTypeErrorValue = val})))))) Nothing]                     Model.ConstraintPropertyUniqueness _ -> [])))-      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingNode p acc guarded)) (Validation.ValidationResult {+      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingNode p acc guarded)) (Validation.ValidationResult {         Validation.validationResultErrors = [],         Validation.validationResultWarnings = []}) (Lists.cons noMatchCheck matchChecks)) @@ -249,6 +250,6 @@                         Neo4j.propertyTypeErrorExpectedType = (Model.propertyTypeConstraintType v0),                         Neo4j.propertyTypeErrorValue = val})))))) Nothing]                     Model.ConstraintPropertyUniqueness _ -> []))-      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingRelationship p acc guarded)) (Validation.ValidationResult {+      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingRelationship p acc guarded)) (Validation.ValidationResult {         Validation.validationResultErrors = [],         Validation.validationResultWarnings = []}) (Lists.cons noSuchTypeCheck (Lists.cons noPatternCheck propChecks)))
src/main/haskell/Hydra/Validate/Pg.hs view
@@ -11,6 +11,7 @@ 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.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Pg.Model as Model@@ -27,9 +28,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -41,9 +42,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -55,9 +56,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -69,9 +70,9 @@           payload = Pairs.second rp           errs = Validation.validationResultErrors acc           wrns = Validation.validationResultWarnings acc-      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {+      in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult {         Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)),-        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {+        Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult {         Validation.validationResultErrors = errs,         Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -105,7 +106,7 @@ -- | Validate an edge against its EdgeType under the given ValidationProfile, returning a ValidationResult InvalidEdgeError. validateEdge :: Validation.ValidationProfile -> (t0 -> t1 -> Maybe Pg.InvalidValueError) -> Maybe (t1 -> Maybe Model.VertexLabel) -> Model.EdgeType t0 -> Model.Edge t1 -> Validation.ValidationResult Pg.InvalidEdgeError validateEdge p checkValue labelForVertexId typ el =-    Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingEdge p acc guarded)) (Validation.ValidationResult {+    Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingEdge p acc guarded)) (Validation.ValidationResult {       Validation.validationResultErrors = [],       Validation.validationResultWarnings = []}) [       Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.label")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.label", f)) (@@ -114,7 +115,7 @@         in (Logic.ifElse (Equality.equal (Model.unEdgeLabel actual) (Model.unEdgeLabel expected)) Nothing (Just (Pg.InvalidEdgeErrorLabel (Pg.NoSuchEdgeLabelError {           Pg.noSuchEdgeLabelErrorLabel = actual})))))) Nothing,       (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.id")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.id", f)) (Optionals.map (\err -> Pg.InvalidEdgeErrorId err) (checkValue (Model.edgeTypeId typ) (Model.edgeId el)))) Nothing),-      (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.property")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.property", f)) (Optionals.map (\err -> Pg.InvalidEdgeErrorProperty err) (Lists.maybeHead (Validation.validationResultErrors (validateProperties p checkValue (Model.edgeTypeProperties typ) (Model.edgeProperties el)))))) Nothing),+      (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.property")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.property", f)) (Optionals.map (\err -> Pg.InvalidEdgeErrorProperty err) (Lists.head (Validation.validationResultErrors (validateProperties p checkValue (Model.edgeTypeProperties typ) (Model.edgeProperties el)))))) Nothing),       (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexNotFound")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexNotFound", f)) (Optionals.cases labelForVertexId Nothing (\f -> Optionals.cases (f (Model.edgeOut el)) (Just Pg.InvalidEdgeErrorOutVertexNotFound) (\_label -> Nothing)))) Nothing),       (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexLabel")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexLabel", f)) (Optionals.cases labelForVertexId Nothing (\f -> Optionals.cases (f (Model.edgeOut el)) Nothing (\label -> Logic.ifElse (Equality.equal (Model.unVertexLabel label) (Model.unVertexLabel (Model.edgeTypeOut typ))) Nothing (Just (Pg.InvalidEdgeErrorOutVertexLabel (Pg.WrongVertexLabelError {         Pg.wrongVertexLabelErrorExpected = (Model.edgeTypeOut typ),@@ -180,14 +181,14 @@                       (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.invalidValue")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.invalidValue", f)) (Optionals.cases (Maps.lookup key m) Nothing (\typ -> Optionals.map (\err -> Pg.InvalidElementPropertyError {                         Pg.invalidElementPropertyErrorKey = key,                         Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorInvalidValue err)}) (checkValue typ val)))) Nothing)])-      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingProperty p acc guarded)) (Validation.ValidationResult {+      in (Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingProperty p acc guarded)) (Validation.ValidationResult {         Validation.validationResultErrors = [],         Validation.validationResultWarnings = []}) (Lists.concat2 missingChecks valueChecks))  -- | Validate a vertex against its VertexType under the given ValidationProfile, returning a ValidationResult InvalidVertexError. validateVertex :: Validation.ValidationProfile -> (t0 -> t1 -> Maybe Pg.InvalidValueError) -> Model.VertexType t0 -> Model.Vertex t1 -> Validation.ValidationResult Pg.InvalidVertexError validateVertex p checkValue typ el =-    Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingVertex p acc guarded)) (Validation.ValidationResult {+    Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingVertex p acc guarded)) (Validation.ValidationResult {       Validation.validationResultErrors = [],       Validation.validationResultWarnings = []}) [       Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidVertexError.label")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidVertexError.label", f)) (@@ -196,4 +197,4 @@         in (Logic.ifElse (Equality.equal (Model.unVertexLabel actual) (Model.unVertexLabel expected)) Nothing (Just (Pg.InvalidVertexErrorLabel (Pg.NoSuchVertexLabelError {           Pg.noSuchVertexLabelErrorLabel = actual})))))) Nothing,       (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidVertexError.id")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidVertexError.id", f)) (Optionals.map (\err -> Pg.InvalidVertexErrorId err) (checkValue (Model.vertexTypeId typ) (Model.vertexId el)))) Nothing),-      (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidVertexError.property")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidVertexError.property", f)) (Optionals.map (\err -> Pg.InvalidVertexErrorProperty err) (Lists.maybeHead (Validation.validationResultErrors (validateProperties p checkValue (Model.vertexTypeProperties typ) (Model.vertexProperties el)))))) Nothing)]+      (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidVertexError.property")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidVertexError.property", f)) (Optionals.map (\err -> Pg.InvalidVertexErrorProperty err) (Lists.head (Validation.validationResultErrors (validateProperties p checkValue (Model.vertexTypeProperties typ) (Model.vertexProperties el)))))) Nothing)]