hydra-pg 0.17.4 → 0.17.5
raw patch · 15 files changed
+233/−103 lines, 15 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)
+ Hydra.Pg.Graphson.Utils: encodeLiteralValue :: Literal -> Either Error Value
Files
- CHANGELOG.md +125/−0
- hydra-pg.cabal +4/−4
- src/main/haskell/Hydra/Decode/Neo4j/Model.hs +4/−4
- src/main/haskell/Hydra/Decode/Pg/Mapping.hs +2/−2
- src/main/haskell/Hydra/Decode/Pg/Model.hs +5/−5
- src/main/haskell/Hydra/Demos/Genpg/Transform.hs +9/−9
- src/main/haskell/Hydra/Graphviz/Coder.hs +3/−3
- src/main/haskell/Hydra/Graphviz/Serde.hs +3/−3
- src/main/haskell/Hydra/Neo4j/Pg.hs +1/−1
- src/main/haskell/Hydra/Pg/Coder.hs +20/−20
- src/main/haskell/Hydra/Pg/Graphson/Construct.hs +1/−1
- src/main/haskell/Hydra/Pg/Graphson/Utils.hs +21/−16
- src/main/haskell/Hydra/Pg/TermsToElements.hs +9/−9
- src/main/haskell/Hydra/Validate/Neo4j.hs +13/−13
- src/main/haskell/Hydra/Validate/Pg.hs +13/−13
CHANGELOG.md view
@@ -15,6 +15,131 @@ --- +## [0.17.5] - 2026-08-19++Point release on the 0.17.x line. Two language-surface changes lead: sum-type eliminators unify on+`match` (scrutinee-first), and the primitive set is tentatively finalized — `strings.lines`/`unlines`+are removed in favour of `hydra.formatting` term helpers. A symlink-aware filesystem family lands+across all ten hosts, and Hydra's own build system continues its migration into Hydra.++**Backward-incompatible.** The `cases` -> `match` rename and the `strings.lines`/`unlines` removal+both change the published kernel surface. Code written against 0.17.4 that uses `Optionals.cases`+or `strings.lines`/`strings.unlines` must be updated.++### Highlights++- **Sum-type eliminators unify on `match`** ([#615](https://github.com/CategoricalData/hydra/issues/615)):+ the `cases`/`match` helper pair is flipped to a single scrutinee-first `match` convention across the+ Haskell, Java, Python, and Scala DSLs, the `optionals.cases` -> `optionals.match` kernel primitive,+ and the corresponding implementations in TypeScript and all four Lisp dialects.+- **Primitive set tentatively finalized** ([#417](https://github.com/CategoricalData/hydra/issues/417)):+ `strings.lines` and `strings.unlines` are removed as primitives; their semantics are preserved as+ `hydra.formatting.lines`/`unlines` term helpers, with overlay implementations dropped across all ten+ hosts and callers repointed.+- **Symlink-aware filesystem primitives** ([#666](https://github.com/CategoricalData/hydra/issues/666)):+ `status(followLinks)`, `createSymlink`, and `readSymlink` land with native implementations for every+ host — Haskell, Java, Python, Scala, TypeScript, Clojure, Common Lisp, Scheme, and Emacs Lisp.+- **Build system promotion continues** ([#416](https://github.com/CategoricalData/hydra/issues/416)):+ adds `hydra.build.walk` extension-glob helpers (`extensionOf`/`filterByExtension`/`matchesExtension`)+ and `hydra.build.comparereportlogic`, a set of pure snapshot-compare decision helpers.++### Bug fixes++- **`math.range` was inclusive of both bounds** ([#647](https://github.com/CategoricalData/hydra/issues/647)),+ silently fabricating an extra element in index arithmetic.+- **Java coder TCO-`cases` codegen** dropped enclosing-method type parameters from union-variant casts+ (found via [#666](https://github.com/CategoricalData/hydra/issues/666)).+- **`ShaclRdf` promoted to a DSL module** ([#652](https://github.com/CategoricalData/hydra/issues/652))+ so the SHACL pipeline works outside Haskell.+- **Cold-seed shim portability**: the R22 bootstrap shim used GNU-only `\+` and `\b`, which fail under+ BSD `sed` on macOS ([#417](https://github.com/CategoricalData/hydra/issues/417)).+- **Bootstrap Haskell target missing `unix`**: the demo's static `package.yaml` was not updated when+ `System.Posix.Files` entered the kernel overlay, breaking every `*-to-haskell` bootstrap cell+ ([#670](https://github.com/CategoricalData/hydra/issues/670)).+- **Bootstrap comparison scored Scala and TypeScript cells as passing without comparing anything**:+ `compare_output`'s target switch was missing both languages, so the baseline path was malformed,+ every file counted as "no baseline found", and a zero-file comparison reported `pass`. A Scala or+ TypeScript *target* cell could never fail ([#671](https://github.com/CategoricalData/hydra/issues/671)).++### Known issues++- A pre-#630 post-generation text pass rewrites `hydra.lib.<sub>` -> `hydra.overlay.<lang>.lib.<sub>`+ in generated **doc comments** as well as code, because its quote-prefix guard does not recognize+ mid-sentence prose references. Affects two kernel doc strings in `src/main`+ (`hydra.error.system`, `hydra.error.packaging`) plus ~20 generated docstrings in the test tree;+ cosmetic only, no behavioral impact. Tracked as part of+ [#633](https://github.com/CategoricalData/hydra/issues/633).+- Bootstrap comparison diff detail is not persisted to the run directory+ ([#671](https://github.com/CategoricalData/hydra/issues/671)).++---++## [0.17.4] - 2026-08-09++Point release on the 0.17.x line. Fixes an inference bug that mis-typed generated Java and Python for+`readFile`, adds the `divide` primitive, and restores `hydra-ext` to the published package set. Release+validation also surfaced a family of pre-existing cross-host code-generation defects — none of which the+per-host CI jobs can catch, because only the bootstrap exercises one host generating *another*.++### Highlights++- **Output-only nominal generalization fixed** ([#637](https://github.com/CategoricalData/hydra/issues/637),+ with [#638](https://github.com/CategoricalData/hydra/issues/638) /+ [#639](https://github.com/CategoricalData/hydra/issues/639) /+ [#640](https://github.com/CategoricalData/hydra/issues/640)): a nominal type appearing only in the+ *output* position of a primitive's signature was generalized to a free type variable instead of resolving+ as nominal, mis-typing the generated Java and Python for `readFile`. Also widens universe closure and adds+ a `kernelTypeUniverse` helper, an effect DSL builder, and `effects`/`files`/`text`/`system` lib wrappers.+- **`divide` primitive** ([#317](https://github.com/CategoricalData/hydra/issues/317)): now present in the+ published kernel. This also clears the cold-clone dangle, since a cold seed against published 0.17.4+ resolves `DefMath.divide`.+- **`hydra-ext` republished** ([#636](https://github.com/CategoricalData/hydra/issues/636)): back in the+ published set after its absence from 0.17.1–0.17.3, shipping to Hackage and PyPI.++### Bug fixes++- **Overlay-lib redirection skipped for the Haskell target**+ ([#630](https://github.com/CategoricalData/hydra/issues/630)):+ the Java, Python, Scheme, Clojure and Common Lisp heads resolved the overlay lib directory using an+ all-lowercase path and did not lower-case the names they scanned. Haskell's overlay tree is capitalized+ (`Hydra/Overlay/Haskell/Lib/`), so every `hydra.lib.*` redirect silently failed and the generated Haskell+ imported `Hydra.Lib.*` instead of `Hydra.Overlay.Haskell.Lib.*`, producing hundreds of type errors. The+ defect was invisible on case-sensitive filesystems, where the failed directory check falls back to a+ hard-coded list that happens to be correct. The Python head carried *two* independent copies of this scan;+ only the one in `generation.py` feeds the Haskell coder.+- **Lisp-as-host bootstrap** ([#520](https://github.com/CategoricalData/hydra/issues/520),+ [#630](https://github.com/CategoricalData/hydra/issues/630)): the four Lisp head decode drivers called+ `from_json` with a stale 4-argument signature, and the Lisp bootstrap-driver coders were not pre-bound with+ `overlaySubs`.+- **Python-as-host dropped the `Graph` argument** ([#630](https://github.com/CategoricalData/hydra/issues/630)):+ `overlaySubs` was not threaded into the Python head's `write_*` wrappers.+- **Clojure `resolve-coder` and `decimal-to-float32`**+ ([#630](https://github.com/CategoricalData/hydra/issues/630)): a stray parenthesis closed a `case` early,+ making an unsupported-default block run unconditionally; and `(float (.doubleValue ...))` threw on+ `Float.MAX_VALUE`, now saturating via `(.floatValue (bigdec x))`.+- **Cold-seeder failed on macOS** ([#630](https://github.com/CategoricalData/hydra/issues/630)): the #376+ cold seeder used a bare `sed -i -e`, which is GNU-only and aborts immediately under BSD `sed`.++### Release engineering++- **Review checkpoint before Maven Central publishes**+ ([#591](https://github.com/CategoricalData/hydra/issues/591)): `HYDRA_JAVA_PUBLISH_HOLD=1` uploads the+ aggregated Java deployment as `USER_MANAGED`, so it validates and then holds for review instead of+ publishing automatically. This mirrors `HYDRA_SCALA_PUBLISH_HOLD` and makes an upload reversible — a held+ deployment can be dropped, whereas an automatic one cannot be undone.++### Known issues++- **`hydra-ext` is not published to Maven Central**+ ([#643](https://github.com/CategoricalData/hydra/issues/643)): it does not compile for the Java target,+ because the visitor-pattern inner interface the Java coder emits collides with the enclosing `Visitor`+ type in `hydra.cpp.syntax`. Only Java is affected; the Python coder emits sibling classes rather than+ nested ones. ext ships to Hackage and PyPI at 0.17.4 and is expected to rejoin the Java set once fixed.+- **TypeScript no longer self-hosts**+ ([#642](https://github.com/CategoricalData/hydra/issues/642)): the TypeScript host's JSON decoder fails to+ decode most of the kernel, so `typescript-as-host` code generation is broken. No published artifact is+ affected — `dist/typescript` is generated by the Haskell host and passes its test suite.+ ## [0.17.3] - 2026-08-01 Point release on the 0.17.x line, focused on **release-artifact integrity**. The 0.17.2 release shipped
hydra-pg.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.39.1.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: hydra-pg-version: 0.17.4+version: 0.17.5 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.4- , hydra-rdf ==0.17.4+ , hydra-kernel ==0.17.5+ , hydra-rdf ==0.17.5 , scientific >=0.3.7 && <0.4 default-language: Haskell2010
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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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.concat [+ in (Optionals.match (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
@@ -74,16 +74,16 @@ value] in case typ of Core.TypeLiteral v0 -> case v0 of- Core.LiteralTypeBoolean -> Optionals.cases (Literals.parseBoolean value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralBoolean parsed))))+ Core.LiteralTypeBoolean -> Optionals.match (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)))))+ Core.FloatTypeFloat32 -> Optionals.match (Literals.readFloat32 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 parsed)))))+ Core.FloatTypeFloat64 -> Optionals.match (Literals.readFloat64 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 parsed))))) _ -> 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)))))+ Core.IntegerTypeInt32 -> Optionals.match (Literals.readInt32 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 parsed)))))+ Core.IntegerTypeInt64 -> Optionals.match (Literals.readInt64 value) (Left parseError) (\parsed -> Right (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 parsed))))) _ -> Left (Strings.concat [ "Unsupported integer type for column ", cname])@@ -94,7 +94,7 @@ _ -> Left (Strings.concat [ "Unsupported type for column ", cname])- in (Optionals.cases mvalue (Right Nothing) decodeValue)+ in (Optionals.match mvalue (Right Nothing) decodeValue) -- | Decode a single data row based on column types decodeRow :: [Tabular.ColumnType] -> Tabular.DataRow String -> Either String (Tabular.DataRow Core.Term)@@ -265,7 +265,7 @@ parseTableLines hasHeader rawLines = Eithers.bind (Eithers.mapList (\ln -> parseSingleLine ln) rawLines) (\parsedRows -> let rows = Optionals.givens parsedRows- in (Logic.ifElse hasHeader (Optionals.cases (Lists.uncons rows) (Left "empty rows: cannot parse header") (\p ->+ in (Logic.ifElse hasHeader (Optionals.match (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 {@@ -298,7 +298,7 @@ id, outId, inId] (Maps.elems props))- 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 [+ in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.match (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.head (Sets.toList tables)) (Left "unreachable: empty tables set") (\x -> Right x)) (Left (Strings.concat [+ in (Logic.ifElse (Equality.equal (Sets.size tables) 1) (Optionals.match (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"])))
src/main/haskell/Hydra/Graphviz/Coder.hs view
@@ -211,7 +211,7 @@ l = Pairs.first tls s = Pairs.second tls in (Names.chooseUniqueLabel vis l, s)- labstyle = Optionals.cases mlabstyle (labelOf visited currentTerm) (\ls -> ls)+ labstyle = Optionals.match mlabstyle (labelOf visited currentTerm) (\ls -> ls) label = Pairs.first labstyle style = Pairs.second labstyle nodeStyle = Logic.ifElse isElement nodeStyleElement termNodeStyle@@ -229,7 +229,7 @@ Dot.EqualityPair { Dot.equalityPairLeft = (Dot.Id "label"), Dot.equalityPairRight = (Dot.Id lab)}]]- parentStmt = Optionals.cases mparent [] (\parent -> [+ parentStmt = Optionals.match mparent [] (\parent -> [ toAccessorEdgeStmt accessor style parent selfId]) selfStmts = Lists.concat [@@ -286,7 +286,7 @@ 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 [+ Core.TermVariable v0 -> Optionals.match (Maps.lookup v0 ids) dflt (\i -> (Lists.concat2 stmts [ toAccessorEdgeStmt accessor style (Optionals.withDefault selfId mparent) i], visited)) _ -> dflt in (Pairs.first (encode Nothing False Maps.empty Nothing ([], Sets.empty) (Paths.SubtermStepAnnotatedBody, term)))
src/main/haskell/Hydra/Graphviz/Serde.hs view
@@ -92,7 +92,7 @@ Lists.concat (Lists.map (\n -> [ Serialization.cst arrow, (nodeOrSubgraphToExpr directed n)]) r)- attrParts = Optionals.cases attr [] (\a -> [+ attrParts = Optionals.match attr [] (\a -> [ attrListToExpr a]) in (Serialization.spaceSep (Lists.concat [ [@@ -171,11 +171,11 @@ let mi = Dot.portId p mp = Dot.portPosition p pre =- Optionals.cases mi [] (\i -> [+ Optionals.match mi [] (\i -> [ Serialization.cst ":", (idToExpr i)]) suf =- Optionals.cases mp [] (\cp -> [+ Optionals.match mp [] (\cp -> [ Serialization.cst ":", (compassPtToExpr cp)]) in (Serialization.noSep (Lists.concat [
src/main/haskell/Hydra/Neo4j/Pg.hs view
@@ -62,7 +62,7 @@ (\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.concat [+ in (Optionals.match (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.withDefault (Neo4jModel.NodeLabel "") (Lists.head labels))) (Left (Strings.concat [ "endpoint node is not single-labeled: ",
src/main/haskell/Hydra/Pg/Coder.hs view
@@ -69,12 +69,12 @@ Eithers.bind (findLabelString cx g source name (Core.Name (Mapping.annotationSchemaEdgeLabel (Mapping.schemaAnnotations schema)))) (\labelStr -> let label = PgModel.EdgeLabel labelStr 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 ->+ in (Eithers.bind (edgeIdAdapter cx g schema eidType name (Core.Name (Mapping.annotationSchemaEdgeId (Mapping.schemaAnnotations schema))) fields) (\idAdapter -> Eithers.bind (Optionals.match mOutSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (projectionAdapter cx g vidType vertexIdsSchema s "out"))) (\outIdAdapter -> Eithers.bind (Optionals.match mInSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (projectionAdapter cx g vidType vertexIdsSchema s "in"))) (\inIdAdapter -> Eithers.bind (Optionals.match mOutSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (findIncidentVertexAdapter cx g schema vidType eidType s))) (\outVertexAdapter -> Eithers.bind (Optionals.match mInSpec (Right Nothing) (\s -> Eithers.map (\x -> Just x) (findIncidentVertexAdapter cx g schema vidType eidType s))) (\inVertexAdapter -> let vertexAdapters = 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)))))))))))+ in (Eithers.bind (Optionals.match mOutSpec (Right parentLabel) (\spec -> Optionals.match (Pairs.second (Pairs.second spec)) (Left (Errors.ErrorOther (Errors.OtherError "no out-vertex label"))) (\a -> Right (PgModel.VertexLabel a)))) (\outLabel -> Eithers.bind (Optionals.match mInSpec (Right parentLabel) (\spec -> Optionals.match (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))))))))))) -- | Construct a vertex coder from components constructVertexCoder :: t0 -> Graph.Graph -> Mapping.Schema t1 t2 t3 Errors.Error -> Core.Type -> t2 -> t2 -> Core.Name -> [Core.FieldType] -> [Coders.Adapter Core.FieldType (PgModel.PropertyType t2) Core.Field (PgModel.Property t3) Errors.Error] -> Either Errors.Error (Coders.Adapter Core.Type (PgModel.ElementTypeTree t2) Core.Term (PgModel.ElementTree t3) Errors.Error)@@ -110,13 +110,13 @@ Core.TermRecord v0 -> v0 in (Eithers.bind (checkRecordName cx tname (Core.recordTypeName rec)) (\_chk -> let fieldsm = Resolution.fieldMap (Core.recordFields rec)- in (Eithers.bind (Optionals.cases mIdAdapter (Right (Mapping.schemaDefaultEdgeId schema)) (selectEdgeId cx fieldsm)) (\edgeId -> Eithers.bind (encodeProperties cx fieldsm propAdapters) (\props ->+ in (Eithers.bind (Optionals.match 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)+ \dirCheck -> \adapter -> Optionals.match (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.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 {+ in (Optionals.match (Maps.lookup fname fieldsm) (Right Nothing) (\fterm -> Eithers.map (\x -> Just x) (Coders.coderEncode (Coders.adapterCoder ad) fterm)))) vertexAdapters)) (\deps -> Right (elementTreeEdge (PgModel.Edge { PgModel.edgeLabel = label, PgModel.edgeId = edgeId, PgModel.edgeOut = outId,@@ -127,14 +127,14 @@ -- | Create an edge id adapter edgeIdAdapter :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> t5 -> Core.Name -> Core.Name -> [Core.FieldType] -> Either Errors.Error (Maybe (Core.Name, (Coders.Adapter Core.Type t5 Core.Term t4 Errors.Error))) edgeIdAdapter cx g schema eidType name idKey fields =- Eithers.bind (findIdProjectionSpec cx False name idKey fields) (\mIdSpec -> Optionals.cases mIdSpec (Right Nothing) (\idSpec -> Eithers.map (\x -> Just x) (projectionAdapter cx g eidType (Mapping.schemaEdgeIds schema) idSpec "id")))+ Eithers.bind (findIdProjectionSpec cx False name idKey fields) (\mIdSpec -> Optionals.match mIdSpec (Right Nothing) (\idSpec -> Eithers.map (\x -> Just x) (projectionAdapter cx g eidType (Mapping.schemaEdgeIds schema) idSpec "id"))) -- | Construct an element adapter for a given type, interpreting it either as a vertex specification or an edge specification elementCoder :: Maybe (PgModel.Direction, PgModel.VertexLabel) -> Mapping.Schema t0 t1 t2 Errors.Error -> Core.Type -> t1 -> t1 -> t3 -> Graph.Graph -> Either Errors.Error (Coders.Adapter Core.Type (PgModel.ElementTypeTree t1) Core.Term (PgModel.ElementTree t2) Errors.Error) elementCoder mparent schema source vidType eidType cx g = - let dir = Optionals.cases mparent PgModel.DirectionBoth (\p -> Pairs.first p)- parentLabel = Optionals.cases mparent (PgModel.VertexLabel "NOLABEL") (\p -> Pairs.second p)+ let dir = Optionals.match mparent PgModel.DirectionBoth (\p -> Pairs.first p)+ parentLabel = Optionals.match mparent (PgModel.VertexLabel "NOLABEL") (\p -> Pairs.second p) in case (Strip.deannotateType source) of Core.TypeOptional v0 -> elementCoder mparent schema v0 vidType eidType cx g Core.TypeRecord v0 ->@@ -197,8 +197,8 @@ \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.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+ in (Optionals.match (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.match v0 (Right Nothing) encodeValue _ -> encodeValue value) (encodeValue value))) -- | Extract a string from a term@@ -217,12 +217,12 @@ Core.Name (case dir of PgModel.DirectionOut -> Mapping.annotationSchemaOutEdgeLabel (Mapping.schemaAnnotations schema) PgModel.DirectionIn -> Mapping.annotationSchemaInEdgeLabel (Mapping.schemaAnnotations schema))- in (Optionals.cases (Annotations.getTypeAnnotation key (Core.fieldTypeType field)) (Right Nothing) (\a -> Eithers.bind (extractString cx g a) (\labelStr -> Eithers.bind (elementCoder (Just (dir, parentLabel)) schema (Core.fieldTypeType field) vidType eidType cx g) (\elad -> Right (Just (dir, (field, (PgModel.EdgeLabel labelStr, elad))))))))) fields)+ in (Optionals.match (Annotations.getTypeAnnotation key (Core.fieldTypeType field)) (Right Nothing) (\a -> Eithers.bind (extractString cx g a) (\labelStr -> Eithers.bind (elementCoder (Just (dir, parentLabel)) schema (Core.fieldTypeType field) vidType eidType cx g) (\elad -> Right (Just (dir, (field, (PgModel.EdgeLabel labelStr, elad))))))))) fields) -- | 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.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 {+ Eithers.bind (findSingleFieldWithAnnotationKey cx tname idKey fields) (\mid -> Optionals.match 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.match (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,@@ -242,12 +242,12 @@ -- | Find a label string from annotations or the type name findLabelString :: t0 -> Graph.Graph -> Core.Type -> Core.Name -> Core.Name -> Either Errors.Error String findLabelString cx g source tname labelKey =- Optionals.cases (Annotations.getTypeAnnotation labelKey source) (Right (Core.unName tname)) (extractString cx g)+ Optionals.match (Annotations.getTypeAnnotation labelKey source) (Right (Core.unName tname)) (extractString cx g) -- | Find a projection spec for a field findProjectionSpec :: t0 -> Graph.Graph -> Core.Name -> Core.Name -> Core.Name -> [Core.FieldType] -> Either Errors.Error (Maybe (Core.FieldType, (Mapping.ValueSpec, (Maybe String)))) findProjectionSpec cx g tname key aliasKey fields =- Eithers.bind (findSingleFieldWithAnnotationKey cx tname key fields) (\mfield -> Optionals.cases mfield (Right Nothing) (\field -> Optionals.cases (Annotations.getTypeAnnotation key (Core.fieldTypeType field)) (Left (Errors.ErrorOther (Errors.OtherError "findProjectionSpec: missing type annotation for key"))) (\annot -> Eithers.bind (TermsToElements.decodeValueSpec cx g annot) (\spec -> Eithers.bind (Optionals.cases (Annotations.getTypeAnnotation aliasKey (Core.fieldTypeType field)) (Right Nothing) (\t -> Eithers.map (\x -> Just x) (extractString cx g t))) (\alias -> Right (Just (field, (spec, alias))))))))+ Eithers.bind (findSingleFieldWithAnnotationKey cx tname key fields) (\mfield -> Optionals.match mfield (Right Nothing) (\field -> Optionals.match (Annotations.getTypeAnnotation key (Core.fieldTypeType field)) (Left (Errors.ErrorOther (Errors.OtherError "findProjectionSpec: missing type annotation for key"))) (\annot -> Eithers.bind (TermsToElements.decodeValueSpec cx g annot) (\spec -> Eithers.bind (Optionals.match (Annotations.getTypeAnnotation aliasKey (Core.fieldTypeType field)) (Right Nothing) (\t -> Eithers.map (\x -> Just x) (extractString cx g t))) (\alias -> Right (Just (field, (spec, alias)))))))) -- | Find property specs for element fields findPropertySpecs :: t0 -> Graph.Graph -> Mapping.Schema t1 t2 t3 t4 -> PgModel.ElementKind -> [Core.FieldType] -> Either Errors.Error [(Core.FieldType, (Mapping.ValueSpec, (Maybe String)))]@@ -255,7 +255,7 @@ Eithers.mapList (\field -> let propKeyKey = Core.Name (Mapping.annotationSchemaPropertyKey (Mapping.schemaAnnotations schema)) propValueKey = Core.Name (Mapping.annotationSchemaPropertyValue (Mapping.schemaAnnotations schema))- in (Eithers.bind (Optionals.cases (Annotations.getTypeAnnotation propKeyKey (Core.fieldTypeType field)) (Right Nothing) (\a -> Eithers.map (\x -> Just x) (extractString cx g a))) (\alias -> Eithers.bind (Optionals.cases (Annotations.getTypeAnnotation propValueKey (Core.fieldTypeType field)) (Right Mapping.ValueSpecValue) (TermsToElements.decodeValueSpec cx g)) (\values -> Right (field, (values, alias)))))) (Lists.filter (\field ->+ in (Eithers.bind (Optionals.match (Annotations.getTypeAnnotation propKeyKey (Core.fieldTypeType field)) (Right Nothing) (\a -> Eithers.map (\x -> Just x) (extractString cx g a))) (\alias -> Eithers.bind (Optionals.match (Annotations.getTypeAnnotation propValueKey (Core.fieldTypeType field)) (Right Mapping.ValueSpecValue) (TermsToElements.decodeValueSpec cx g)) (\values -> Right (field, (values, alias)))))) (Lists.filter (\field -> let annots = Mapping.schemaAnnotations schema ignoreKey = Core.Name (Mapping.annotationSchemaIgnore annots) specialKeys =@@ -344,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.concat2 (Strings.concat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))+ in (Optionals.match (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@@ -352,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.concat2 (Strings.concat2 "no " (Core.unName fname)) " in record")))) (\t -> Coders.coderEncode (Coders.adapterCoder adapter) t))+ in (Optionals.match (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.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"))))))+ 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.match (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] -> [(@@ -394,7 +394,7 @@ eaField = Pairs.first (Pairs.second ea) eaLabel = Pairs.first (Pairs.second (Pairs.second ea)) eaAdapter = Pairs.second (Pairs.second (Pairs.second ea))- in (Optionals.cases (Maps.lookup (Core.fieldTypeName eaField) fmap) (Right []) (\fterm -> Eithers.map (\tree -> (\x -> case x of+ in (Optionals.match (Maps.lookup (Core.fieldTypeName eaField) fmap) (Right []) (\fterm -> Eithers.map (\tree -> (\x -> case x of PgModel.ElementVertex v0 -> let otherid = PgModel.vertexId v0 edgeid = Mapping.schemaDefaultEdgeId schema@@ -445,4 +445,4 @@ -- | Create a vertex id adapter vertexIdAdapter :: t0 -> t1 -> Mapping.Schema t2 t3 t4 Errors.Error -> t5 -> Core.Name -> Core.Name -> [Core.FieldType] -> Either Errors.Error (Core.Name, (Coders.Adapter Core.Type t5 Core.Term t4 Errors.Error)) vertexIdAdapter cx g schema vidType name idKey fields =- Eithers.bind (findIdProjectionSpec cx True name idKey fields) (\mIdSpec -> Optionals.cases mIdSpec (Left (Errors.ErrorOther (Errors.OtherError "vertexIdAdapter: no id projection spec"))) (\idSpec -> projectionAdapter cx g vidType (Mapping.schemaVertexIds schema) idSpec "id"))+ Eithers.bind (findIdProjectionSpec cx True name idKey fields) (\mIdSpec -> Optionals.match mIdSpec (Left (Errors.ErrorOther (Errors.OtherError "vertexIdAdapter: no id projection spec"))) (\idSpec -> projectionAdapter cx g vidType (Mapping.schemaVertexIds schema) idSpec "id"))
src/main/haskell/Hydra/Pg/Graphson/Construct.hs view
@@ -67,7 +67,7 @@ let k = Pairs.first p v = Pairs.second p existing = Maps.lookup k m- in (Maps.insert k (Optionals.cases existing (Lists.pure v) (\vs -> Lists.cons v vs)) m)) Maps.empty pairs+ in (Maps.insert k (Optionals.match existing (Lists.pure v) (\vs -> Lists.cons v vs)) m)) Maps.empty pairs -- | Convert a property graph edge property to a GraphSON property edgePropertyToGraphson :: (t0 -> Either t1 t2) -> (PgModel.PropertyKey, t0) -> Either t1 (Syntax.PropertyKey, t2)
src/main/haskell/Hydra/Pg/Graphson/Utils.hs view
@@ -83,16 +83,34 @@ PgModel.adjacentEdgeVertex = outV, PgModel.adjacentEdgeProperties = props} vmap1 =- Optionals.cases (Maps.lookup outV vmap) vmap (\vae -> Maps.insert outV (PgModel.VertexWithAdjacentEdges {+ Optionals.match (Maps.lookup outV vmap) vmap (\vae -> Maps.insert outV (PgModel.VertexWithAdjacentEdges { PgModel.vertexWithAdjacentEdgesVertex = (PgModel.vertexWithAdjacentEdgesVertex vae), PgModel.vertexWithAdjacentEdgesIns = (PgModel.vertexWithAdjacentEdgesIns vae), PgModel.vertexWithAdjacentEdgesOuts = (Lists.cons adjEdgeOut (PgModel.vertexWithAdjacentEdgesOuts vae))}) vmap)- in (Optionals.cases (Maps.lookup inV vmap1) vmap1 (\vae -> Maps.insert inV (PgModel.VertexWithAdjacentEdges {+ in (Optionals.match (Maps.lookup inV vmap1) vmap1 (\vae -> Maps.insert inV (PgModel.VertexWithAdjacentEdges { PgModel.vertexWithAdjacentEdgesVertex = (PgModel.vertexWithAdjacentEdgesVertex vae), PgModel.vertexWithAdjacentEdgesIns = (Lists.cons adjEdgeIn (PgModel.vertexWithAdjacentEdgesIns vae)), PgModel.vertexWithAdjacentEdgesOuts = (PgModel.vertexWithAdjacentEdgesOuts vae)}) vmap1))) vertexMap0 edges in (Maps.elems vertexMap1) +-- | Encode a Hydra Literal as a GraphSON Value+encodeLiteralValue :: Core.Literal -> Either Errors.Error Syntax.Value+encodeLiteralValue lit =+ case lit of+ Core.LiteralBinary v0 -> Right (Syntax.ValueBinary (Literals.binaryToBase64 v0))+ Core.LiteralBoolean v0 -> Right (Syntax.ValueBoolean v0)+ Core.LiteralFloat v0 -> case v0 of+ Core.FloatValueFloat32 v1 -> Right (Syntax.ValueFloat (Syntax.FloatValueFinite v1))+ Core.FloatValueFloat64 v1 -> Right (Syntax.ValueDouble (Syntax.DoubleValueFinite v1))+ _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported float type"))+ Core.LiteralInteger v0 -> case v0 of+ Core.IntegerValueBigint v1 -> Right (Syntax.ValueBigInteger v1)+ Core.IntegerValueInt32 v1 -> Right (Syntax.ValueInteger v1)+ Core.IntegerValueInt64 v1 -> Right (Syntax.ValueLong v1)+ _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported integer type"))+ Core.LiteralString v0 -> Right (Syntax.ValueString v0)+ _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported literal type for GraphSON encoding"))+ -- | Encode a String value as a GraphSON Value encodeStringValue :: String -> Either t0 Syntax.Value encodeStringValue s = Right (Syntax.ValueString s)@@ -101,20 +119,7 @@ encodeTermValue :: Core.Term -> Either Errors.Error Syntax.Value encodeTermValue term = case (Strip.deannotateTerm term) of- Core.TermLiteral v0 -> case v0 of- 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))- Core.FloatValueFloat64 v2 -> Right (Syntax.ValueDouble (Syntax.DoubleValueFinite v2))- _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported float type"))- Core.LiteralInteger v1 -> case v1 of- Core.IntegerValueBigint v2 -> Right (Syntax.ValueBigInteger v2)- Core.IntegerValueInt32 v2 -> Right (Syntax.ValueInteger v2)- Core.IntegerValueInt64 v2 -> Right (Syntax.ValueLong v2)- _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported integer type"))- Core.LiteralString v1 -> Right (Syntax.ValueString v1)- _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported literal type for GraphSON encoding"))+ Core.TermLiteral v0 -> encodeLiteralValue v0 Core.TermUnit -> Right Syntax.ValueNull _ -> Left (Errors.ErrorOther (Errors.OtherError "unsupported term variant for GraphSON encoding"))
src/main/haskell/Hydra/Pg/TermsToElements.hs view
@@ -123,7 +123,7 @@ -- | Evaluate a path (list of steps) on a term, returning all resulting terms evalPath :: t0 -> [String] -> Core.Term -> Either Errors.Error [Core.Term] evalPath cx path term =- Optionals.cases (Lists.uncons path) (Right [+ Optionals.match (Lists.uncons path) (Right [ term]) (\p -> Eithers.bind (evalStep cx (Pairs.first p) term) (\results -> Eithers.map (\xs -> Lists.concat xs) (Eithers.mapList (evalPath cx (Pairs.second p)) results))) -- | Evaluate a single step of a path traversal on a term@@ -132,8 +132,8 @@ Logic.ifElse (Strings.null step) (Right [ term]) (case (Strip.deannotateTerm term) of Core.TermList v0 -> Eithers.map (\xs -> Lists.concat xs) (Eithers.mapList (evalStep cx step) v0)- Core.TermOptional v0 -> Optionals.cases v0 (Right []) (\t -> evalStep cx step t)- Core.TermRecord v0 -> Optionals.cases (Maps.lookup (Core.Name step) (Resolution.fieldMap (Core.recordFields v0))) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 (Strings.concat2 "No such field " step) " in record")))) (\t -> Right [+ Core.TermOptional v0 -> Optionals.match v0 (Right []) (\t -> evalStep cx step t)+ Core.TermRecord v0 -> Optionals.match (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)@@ -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.concat2 "no such field: " (Core.unName fname))))) fun+ Optionals.match (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.head entries) (Left (Errors.ErrorOther (Errors.OtherError "empty injection"))) (\f ->+ in (Optionals.match (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.head matching) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "unexpected field: " (Core.unName key))))) (\m ->+ in (Optionals.match (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,14 +252,14 @@ -- | 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.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))))))+ 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.match (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) termToElementsAdapter cx g schema typ = let key_elements = Core.Name "elements"- in (Optionals.cases (Annotations.getTypeAnnotation key_elements typ) (Right (Coders.Adapter {+ in (Optionals.match (Annotations.getTypeAnnotation key_elements typ) (Right (Coders.Adapter { Coders.adapterIsLossy = False, Coders.adapterSource = typ, Coders.adapterTarget = [],@@ -290,5 +290,5 @@ Core.FloatValueFloat64 v2 -> Literals.showFloat64 v2 _ -> PrintCore.term term _ -> PrintCore.term term- Core.TermOptional v0 -> Optionals.cases v0 "none" (\t -> termToString t)+ Core.TermOptional v0 -> Optionals.match v0 "none" (\t -> termToString t) _ -> PrintCore.term term
src/main/haskell/Hydra/Validate/Neo4j.hs view
@@ -42,7 +42,7 @@ -- | Append a rule-tagged InvalidNodeError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFindingNode :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingNode p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -56,7 +56,7 @@ -- | Append a rule-tagged InvalidRelationshipError finding to a ValidationResult. appendFindingRelationship :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingRelationship p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -201,12 +201,12 @@ Lists.bind matches (\net -> Lists.concat2 (Lists.map (\lab -> Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.missingImpliedLabel")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.missingImpliedLabel", f)) (Logic.ifElse (Sets.member lab nodeLabels) Nothing (Just (Neo4j.InvalidNodeErrorMissingImpliedLabel (Neo4j.MissingLabelError { Neo4j.missingLabelErrorLabel = lab}))))) Nothing) (Sets.toList (Model.nodeElementTypeImpliedLabels net))) (Lists.bind (Model.nodeElementTypeConstraints net) (\cd -> case (Model.constraintDefinitionBody cd) of Model.ConstraintPropertyExistence v0 -> [- Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty", f)) (Optionals.cases (Maps.lookup (Model.propertyExistenceConstraintProperty v0) props) (Just (Neo4j.InvalidNodeErrorMissingProperty (Neo4j.PropertyExistenceError {+ Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty", f)) (Optionals.match (Maps.lookup (Model.propertyExistenceConstraintProperty v0) props) (Just (Neo4j.InvalidNodeErrorMissingProperty (Neo4j.PropertyExistenceError { Neo4j.propertyExistenceErrorKey = (Model.propertyExistenceConstraintProperty v0)}))) (\_ -> Nothing))) Nothing]- Model.ConstraintKey v0 -> Lists.map (\k -> Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty", f)) (Optionals.cases (Maps.lookup k props) (Just (Neo4j.InvalidNodeErrorMissingProperty (Neo4j.PropertyExistenceError {+ Model.ConstraintKey v0 -> Lists.map (\k -> Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.missingProperty", f)) (Optionals.match (Maps.lookup k props) (Just (Neo4j.InvalidNodeErrorMissingProperty (Neo4j.PropertyExistenceError { Neo4j.propertyExistenceErrorKey = k}))) (\_ -> Nothing))) Nothing) (Model.keyConstraintProperties v0) Model.ConstraintPropertyType v0 -> [- Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.wrongPropertyType")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.wrongPropertyType", f)) (Optionals.cases (Maps.lookup (Model.propertyTypeConstraintProperty v0) props) Nothing (\val -> Logic.ifElse (matchesValueType (Model.propertyTypeConstraintType v0) val) Nothing (Just (Neo4j.InvalidNodeErrorWrongPropertyType (Neo4j.PropertyTypeError {+ Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidNodeError.wrongPropertyType")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidNodeError.wrongPropertyType", f)) (Optionals.match (Maps.lookup (Model.propertyTypeConstraintProperty v0) props) Nothing (\val -> Logic.ifElse (matchesValueType (Model.propertyTypeConstraintType v0) val) Nothing (Just (Neo4j.InvalidNodeErrorWrongPropertyType (Neo4j.PropertyTypeError { Neo4j.propertyTypeErrorKey = (Model.propertyTypeConstraintProperty v0), Neo4j.propertyTypeErrorExpectedType = (Model.propertyTypeConstraintType v0), Neo4j.propertyTypeErrorValue = val})))))) Nothing]@@ -221,12 +221,12 @@ let relType = Model.relationshipType rel props = Model.relationshipProperties rel- startLabels = Optionals.cases labelsForId Nothing (\f -> f (Model.relationshipStart rel))- endLabels = Optionals.cases labelsForId Nothing (\f -> f (Model.relationshipEnd rel))+ startLabels = Optionals.match labelsForId Nothing (\f -> f (Model.relationshipStart rel))+ endLabels = Optionals.match labelsForId Nothing (\f -> f (Model.relationshipEnd rel)) candidates = Lists.filter (\ret -> Equality.equal (Model.unRelationshipType (Model.relationshipElementTypeType ret)) (Model.unRelationshipType relType)) (Model.graphTypeRelationships gt) matched =- Lists.filter (\ret -> Logic.and (Optionals.cases startLabels True (\ls -> Sets.member (Model.relationshipElementTypeStartLabel ret) ls)) (Optionals.cases endLabels True (\ls -> Sets.member (Model.relationshipElementTypeEndLabel ret) ls))) candidates+ Lists.filter (\ret -> Logic.and (Optionals.match startLabels True (\ls -> Sets.member (Model.relationshipElementTypeStartLabel ret) ls)) (Optionals.match endLabels True (\ls -> Sets.member (Model.relationshipElementTypeEndLabel ret) ls))) candidates noSuchTypeCheck = Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.noSuchType")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.noSuchType", f)) (Logic.ifElse (Lists.null candidates) (Just (Neo4j.InvalidRelationshipErrorNoSuchType (Neo4j.NoSuchRelationshipTypeError { Neo4j.noSuchRelationshipTypeErrorType = relType}))) Nothing)) Nothing@@ -235,17 +235,17 @@ Neo4j.noMatchingPatternErrorAllowedPatterns = (Lists.map (\ret -> Neo4j.RelationshipPattern { Neo4j.relationshipPatternStartLabel = (Model.relationshipElementTypeStartLabel ret), Neo4j.relationshipPatternEndLabel = (Model.relationshipElementTypeEndLabel ret)}) candidates),- Neo4j.noMatchingPatternErrorActualStartLabels = (Optionals.cases startLabels [] (\ls -> Sets.toList ls)),- Neo4j.noMatchingPatternErrorActualEndLabels = (Optionals.cases endLabels [] (\ls -> Sets.toList ls))}))) Nothing)) Nothing+ Neo4j.noMatchingPatternErrorActualStartLabels = (Optionals.match startLabels [] (\ls -> Sets.toList ls)),+ Neo4j.noMatchingPatternErrorActualEndLabels = (Optionals.match endLabels [] (\ls -> Sets.toList ls))}))) Nothing)) Nothing propChecks = Lists.bind matched (\ret -> Lists.bind (Model.relationshipElementTypeConstraints ret) (\cd -> case (Model.constraintDefinitionBody cd) of Model.ConstraintPropertyExistence v0 -> [- Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty", f)) (Optionals.cases (Maps.lookup (Model.propertyExistenceConstraintProperty v0) props) (Just (Neo4j.InvalidRelationshipErrorMissingProperty (Neo4j.PropertyExistenceError {+ Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty", f)) (Optionals.match (Maps.lookup (Model.propertyExistenceConstraintProperty v0) props) (Just (Neo4j.InvalidRelationshipErrorMissingProperty (Neo4j.PropertyExistenceError { Neo4j.propertyExistenceErrorKey = (Model.propertyExistenceConstraintProperty v0)}))) (\_ -> Nothing))) Nothing]- Model.ConstraintKey v0 -> Lists.map (\k -> Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty", f)) (Optionals.cases (Maps.lookup k props) (Just (Neo4j.InvalidRelationshipErrorMissingProperty (Neo4j.PropertyExistenceError {+ Model.ConstraintKey v0 -> Lists.map (\k -> Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.missingProperty", f)) (Optionals.match (Maps.lookup k props) (Just (Neo4j.InvalidRelationshipErrorMissingProperty (Neo4j.PropertyExistenceError { Neo4j.propertyExistenceErrorKey = k}))) (\_ -> Nothing))) Nothing) (Model.keyConstraintProperties v0) Model.ConstraintPropertyType v0 -> [- Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.wrongPropertyType")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.wrongPropertyType", f)) (Optionals.cases (Maps.lookup (Model.propertyTypeConstraintProperty v0) props) Nothing (\val -> Logic.ifElse (matchesValueType (Model.propertyTypeConstraintType v0) val) Nothing (Just (Neo4j.InvalidRelationshipErrorWrongPropertyType (Neo4j.PropertyTypeError {+ Logic.ifElse (enabledNeo4j p (Core.Name "hydra.error.neo4j.InvalidRelationshipError.wrongPropertyType")) (Optionals.map (\f -> (Core.Name "hydra.error.neo4j.InvalidRelationshipError.wrongPropertyType", f)) (Optionals.match (Maps.lookup (Model.propertyTypeConstraintProperty v0) props) Nothing (\val -> Logic.ifElse (matchesValueType (Model.propertyTypeConstraintType v0) val) Nothing (Just (Neo4j.InvalidRelationshipErrorWrongPropertyType (Neo4j.PropertyTypeError { Neo4j.propertyTypeErrorKey = (Model.propertyTypeConstraintProperty v0), Neo4j.propertyTypeErrorExpectedType = (Model.propertyTypeConstraintType v0), Neo4j.propertyTypeErrorValue = val})))))) Nothing]
src/main/haskell/Hydra/Validate/Pg.hs view
@@ -23,7 +23,7 @@ -- | Append a rule-tagged InvalidEdgeError finding to a ValidationResult. appendFindingEdge :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingEdge p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -37,7 +37,7 @@ -- | Append a rule-tagged InvalidGraphError finding to a ValidationResult. appendFindingGraph :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingGraph p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -51,7 +51,7 @@ -- | Append a rule-tagged InvalidElementPropertyError finding to a ValidationResult. appendFindingProperty :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingProperty p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -65,7 +65,7 @@ -- | Append a rule-tagged InvalidVertexError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFindingVertex :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingVertex p acc finding =- Optionals.cases finding acc (\rp ->+ Optionals.match finding acc (\rp -> let ruleName = Pairs.first rp payload = Pairs.second rp errs = Validation.validationResultErrors acc@@ -116,12 +116,12 @@ 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.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 {+ (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexNotFound")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.outVertexNotFound", f)) (Optionals.match labelForVertexId Nothing (\f -> Optionals.match (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.match labelForVertexId Nothing (\f -> Optionals.match (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), Pg.wrongVertexLabelErrorActual = label}))))))) Nothing),- (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexNotFound")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexNotFound", f)) (Optionals.cases labelForVertexId Nothing (\f -> Optionals.cases (f (Model.edgeIn el)) (Just Pg.InvalidEdgeErrorInVertexNotFound) (\_label -> Nothing)))) Nothing),- (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexLabel")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexLabel", f)) (Optionals.cases labelForVertexId Nothing (\f -> Optionals.cases (f (Model.edgeIn el)) Nothing (\label -> Logic.ifElse (Equality.equal (Model.unVertexLabel label) (Model.unVertexLabel (Model.edgeTypeIn typ))) Nothing (Just (Pg.InvalidEdgeErrorInVertexLabel (Pg.WrongVertexLabelError {+ (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexNotFound")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexNotFound", f)) (Optionals.match labelForVertexId Nothing (\f -> Optionals.match (f (Model.edgeIn el)) (Just Pg.InvalidEdgeErrorInVertexNotFound) (\_label -> Nothing)))) Nothing),+ (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexLabel")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidEdgeError.inVertexLabel", f)) (Optionals.match labelForVertexId Nothing (\f -> Optionals.match (f (Model.edgeIn el)) Nothing (\label -> Logic.ifElse (Equality.equal (Model.unVertexLabel label) (Model.unVertexLabel (Model.edgeTypeIn typ))) Nothing (Just (Pg.InvalidEdgeErrorInVertexLabel (Pg.WrongVertexLabelError { Pg.wrongVertexLabelErrorExpected = (Model.edgeTypeIn typ), Pg.wrongVertexLabelErrorActual = label}))))))) Nothing)] @@ -134,7 +134,7 @@ Lists.bind (Maps.elems (Model.graphVertices graph)) (\el -> let tOpt = Maps.lookup (Model.vertexLabel el) (Model.graphSchemaVertices schema) perVertex =- Optionals.cases tOpt (Validation.ValidationResult {+ Optionals.match tOpt (Validation.ValidationResult { Validation.validationResultErrors = [ Pg.InvalidVertexErrorLabel (Pg.NoSuchVertexLabelError { Pg.noSuchVertexLabelErrorLabel = (Model.vertexLabel el)})],@@ -146,7 +146,7 @@ Lists.bind (Maps.elems (Model.graphEdges graph)) (\el -> let tOpt = Maps.lookup (Model.edgeLabel el) (Model.graphSchemaEdges schema) perEdge =- Optionals.cases tOpt (Validation.ValidationResult {+ Optionals.match tOpt (Validation.ValidationResult { Validation.validationResultErrors = [ Pg.InvalidEdgeErrorLabel (Pg.NoSuchEdgeLabelError { Pg.noSuchEdgeLabelErrorLabel = (Model.edgeLabel el)})],@@ -167,7 +167,7 @@ let m = Maps.fromList (Lists.map (\pt -> (Model.propertyTypeKey pt, (Model.propertyTypeValue pt))) types) missingChecks =- Lists.map (\t -> Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.missingRequired")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.missingRequired", f)) (Logic.ifElse (Model.propertyTypeRequired t) (Optionals.cases (Maps.lookup (Model.propertyTypeKey t) props) (Just (Pg.InvalidElementPropertyError {+ Lists.map (\t -> Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.missingRequired")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.missingRequired", f)) (Logic.ifElse (Model.propertyTypeRequired t) (Optionals.match (Maps.lookup (Model.propertyTypeKey t) props) (Just (Pg.InvalidElementPropertyError { Pg.invalidElementPropertyErrorKey = (Model.propertyTypeKey t), Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorMissingRequired (Model.propertyTypeKey t))})) (\_ -> Nothing)) Nothing)) Nothing) types valueChecks =@@ -175,10 +175,10 @@ let key = Pairs.first kv val = Pairs.second kv in [- Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.unexpectedKey")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.unexpectedKey", f)) (Optionals.cases (Maps.lookup key m) (Just (Pg.InvalidElementPropertyError {+ Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.unexpectedKey")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.unexpectedKey", f)) (Optionals.match (Maps.lookup key m) (Just (Pg.InvalidElementPropertyError { Pg.invalidElementPropertyErrorKey = key, Pg.invalidElementPropertyErrorError = (Pg.InvalidPropertyErrorUnexpectedKey key)})) (\_ -> Nothing))) Nothing,- (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 {+ (Logic.ifElse (enabledPg p (Core.Name "hydra.error.pg.InvalidPropertyError.invalidValue")) (Optionals.map (\f -> (Core.Name "hydra.error.pg.InvalidPropertyError.invalidValue", f)) (Optionals.match (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 (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingProperty p acc guarded)) (Validation.ValidationResult {