hydra-ext 0.17.4 → 0.17.5
raw patch · 17 files changed
+264/−159 lines, 17 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
- CHANGELOG.md +125/−0
- hydra-ext.cabal +4/−4
- src/main/haskell/Hydra/Avro/Coder.hs +17/−17
- src/main/haskell/Hydra/Avro/Encoder.hs +6/−6
- src/main/haskell/Hydra/Avro/SchemaJson.hs +14/−14
- src/main/haskell/Hydra/Cpp/Names.hs +2/−2
- src/main/haskell/Hydra/Cpp/Serde.hs +11/−11
- src/main/haskell/Hydra/Graphql/Coder.hs +8/−25
- src/main/haskell/Hydra/Graphql/Serde.hs +2/−2
- src/main/haskell/Hydra/Json/Schema/Coder.hs +3/−3
- src/main/haskell/Hydra/Pegasus/Coder.hs +1/−1
- src/main/haskell/Hydra/Protobuf/Coder.hs +7/−12
- src/main/haskell/Hydra/Protobuf/Serde.hs +2/−2
- src/main/haskell/Hydra/Rust/Coder.hs +6/−6
- src/main/haskell/Hydra/Rust/Serde.hs +53/−52
- src/main/haskell/Hydra/Yaml/Coder.hs +1/−1
- src/main/haskell/Hydra/Yaml/Serde.hs +2/−1
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-ext.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-ext-version: 0.17.4+version: 0.17.5 synopsis: Hydra extensions: additional coders and schema integrations 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". Various extensions to Hydra category: Data@@ -90,7 +90,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/Avro/Coder.hs view
@@ -56,7 +56,7 @@ -- | Annotate an adapter's target type with optional annotations annotateAdapter :: Maybe (M.Map Core.Name Core.Term) -> Coders.Adapter t0 Core.Type t1 t2 t3 -> Coders.Adapter t0 Core.Type t1 t2 t3 annotateAdapter ann ad =- Optionals.cases ann ad (\n -> Coders.Adapter {+ Optionals.match ann ad (\n -> Coders.Adapter { Coders.adapterIsLossy = (Coders.adapterIsLossy ad), Coders.adapterSource = (Coders.adapterSource ad), Coders.adapterTarget = (Core.TypeAnnotated (Core.AnnotatedType {@@ -140,7 +140,7 @@ manns = namedAnnotationsToCore v0 ann = Logic.ifElse (Maps.null manns) Nothing (Just manns) lastNs = Environment.avroEnvironmentNamespace env0- nextNs = Optionals.cases ns lastNs (\s -> Just s)+ nextNs = Optionals.match ns lastNs (\s -> Just s) env1 = Environment.AvroEnvironment { Environment.avroEnvironmentNamedAdapters = (Environment.avroEnvironmentNamedAdapters env0),@@ -151,7 +151,7 @@ Environment.avroQualifiedNameNamespace = nextNs, Environment.avroQualifiedNameName = (Schema.namedName v0)} hydraName = avroNameToHydraName qname- in (Optionals.cases (getAvroHydraAdapter qname env1) (Eithers.bind (case (Schema.namedType v0) of+ in (Optionals.match (getAvroHydraAdapter qname env1) (Eithers.bind (case (Schema.namedType v0) of Schema.NamedTypeEnum v1 -> let syms = Schema.enumSymbols v1 typ =@@ -188,7 +188,7 @@ \entry -> let k = Pairs.first entry v = Pairs.second entry- in (Optionals.cases (Maps.lookup k adaptersByFieldName) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [+ in (Optionals.match (Maps.lookup k adaptersByFieldName) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [ "unrecognized field for ", (showQname qname), ": ",@@ -199,7 +199,7 @@ \fld -> let k = Core.unName (Core.fieldName fld) v = Core.fieldTerm fld- in (Optionals.cases (Maps.lookup k adaptersByFieldName) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [+ in (Optionals.match (Maps.lookup k adaptersByFieldName) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [ "unrecognized field for ", (showQname qname), ": ",@@ -316,7 +316,7 @@ Graph.graphTypeVariables = Sets.empty}) t)) Schema.SchemaReference v0 -> let qname = parseAvroName (Environment.avroEnvironmentNamespace env0) v0- in (Optionals.cases (getAvroHydraAdapter qname env0) (err cx (Strings.concat2 "Referenced Avro type has not been defined: " (showQname qname))) (\ad -> Right (ad, env0)))+ in (Optionals.match (getAvroHydraAdapter qname env0) (err cx (Strings.concat2 "Referenced Avro type has not been defined: " (showQname qname))) (\ad -> Right (ad, env0))) Schema.SchemaUnion v0 -> let schemas = Schema.unUnion v0 isNull =@@ -341,9 +341,9 @@ Model.ValueNull -> Right (Core.TermOptional Nothing) _ -> Eithers.map (\t -> Core.TermOptional (Just t)) (Coders.coderEncode (Coders.adapterCoder ad) v)), Coders.coderDecode = (\t -> case t of- Core.TermOptional v1 -> Optionals.cases v1 (Right Model.ValueNull) (\term_ -> Coders.coderDecode (Coders.adapterCoder ad) term_))}},+ Core.TermOptional v1 -> Optionals.match v1 (Right Model.ValueNull) (\term_ -> Coders.coderDecode (Coders.adapterCoder ad) term_))}}, env1)))- in (Logic.ifElse (Ordering.gt (Lists.length nonNulls) 1) (err cx "general-purpose unions are not yet supported") (Optionals.cases (Lists.head nonNulls) (err cx "cannot generate the empty type") (\nonNullHead -> Logic.ifElse hasNull (forOptional nonNullHead) (Eithers.bind (avroHydraAdapter cx nonNullHead env0) (\adEnv ->+ in (Logic.ifElse (Ordering.gt (Lists.length nonNulls) 1) (err cx "general-purpose unions are not yet supported") (Optionals.match (Lists.head nonNulls) (err cx "cannot generate the empty type") (\nonNullHead -> Logic.ifElse hasNull (forOptional nonNullHead) (Eithers.bind (avroHydraAdapter cx nonNullHead env0) (\adEnv -> let ad = Pairs.first adEnv env1 = Pairs.second adEnv in (Right (@@ -430,8 +430,8 @@ -- | Extract a foreign key annotation from a field, if present foreignKeyE :: t0 -> Schema.Field -> Either Errors.Error (Maybe Environment.AvroForeignKey) foreignKeyE cx f =- Optionals.cases (Maps.lookup avroForeignKey (Schema.fieldAnnotations f)) (Right Nothing) (\v -> Eithers.bind (expectObjectE cx v) (\m -> Eithers.bind (Eithers.map (\s -> Core.Name s) (requireStringE cx "type" m)) (\tname -> Eithers.bind (optStringE cx "pattern" m) (\pattern_ ->- let constr = Optionals.cases pattern_ (\s -> Core.Name s) (\pat -> patternToNameConstructor pat)+ Optionals.match (Maps.lookup avroForeignKey (Schema.fieldAnnotations f)) (Right Nothing) (\v -> Eithers.bind (expectObjectE cx v) (\m -> Eithers.bind (Eithers.map (\s -> Core.Name s) (requireStringE cx "type" m)) (\tname -> Eithers.bind (optStringE cx "pattern" m) (\pattern_ ->+ let constr = Optionals.match pattern_ (\s -> Core.Name s) (\pat -> patternToNameConstructor pat) in (Right (Just (Environment.AvroForeignKey { Environment.avroForeignKeyTypeName = tname, Environment.avroForeignKeyConstructor = constr})))))))@@ -460,7 +460,7 @@ -- | Look up an optional string attribute in a JSON object map optStringE :: Ord t1 => (t0 -> t1 -> M.Map t1 Model.Value -> Either t2 (Maybe String)) optStringE cx fname m =- Optionals.cases (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\s -> Optionals.pure s) (expectStringE cx v))+ Optionals.match (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\s -> Optionals.pure s) (expectStringE cx v)) -- | Parse a dotted Avro name into a qualified name parseAvroName :: Maybe String -> String -> Environment.AvroQualifiedName@@ -486,7 +486,7 @@ let manns = fieldAnnotationsToCore f ann = Logic.ifElse (Maps.null manns) Nothing (Just manns)- in (Eithers.bind (foreignKeyE cx f) (\fk -> Eithers.bind (Optionals.cases fk (avroHydraAdapter cx (Schema.fieldType f) env) (\fkVal ->+ in (Eithers.bind (foreignKeyE cx f) (\fk -> Eithers.bind (Optionals.match fk (avroHydraAdapter cx (Schema.fieldType f) env) (\fkVal -> let fkName = Environment.avroForeignKeyTypeName fkVal fkConstr = Environment.avroForeignKeyConstructor fkVal in (Eithers.bind (avroHydraAdapter cx (Schema.fieldType f) env) (\adEnvPair ->@@ -546,7 +546,7 @@ -- | Extract a primary key annotation from a field, if present primaryKeyE :: t0 -> Schema.Field -> Maybe Environment.AvroPrimaryKey primaryKeyE cx f =- Optionals.cases (Maps.lookup avroPrimaryKey (Schema.fieldAnnotations f)) Nothing (\v -> Eithers.either (\_ -> Nothing) (\s -> Just (Environment.AvroPrimaryKey {+ Optionals.match (Maps.lookup avroPrimaryKey (Schema.fieldAnnotations f)) Nothing (\v -> Eithers.either (\_ -> Nothing) (\s -> Just (Environment.AvroPrimaryKey { Environment.avroPrimaryKeyFieldName = (Core.Name (Schema.fieldName f)), Environment.avroPrimaryKeyConstructor = (patternToNameConstructor s)})) (expectStringE cx v)) @@ -561,7 +561,7 @@ -- | Look up a required string attribute in a JSON object map requireStringE :: t0 -> String -> M.Map String Model.Value -> Either Errors.Error String requireStringE cx fname m =- Optionals.cases (Maps.lookup fname m) (err cx (Strings.concat [+ Optionals.match (Maps.lookup fname m) (err cx (Strings.concat [ "required attribute ", (Literals.printString fname), " not found"])) (\v -> expectStringE cx v)@@ -604,14 +604,14 @@ let mns = Environment.avroQualifiedNameNamespace qname local = Environment.avroQualifiedNameName qname- in (Strings.concat2 (Optionals.cases mns "" (\ns -> Strings.concat2 ns ".")) local)+ in (Strings.concat2 (Optionals.match mns "" (\ns -> Strings.concat2 ns ".")) local) -- | Parse a string into a term of the expected type stringToTermE :: t0 -> Core.Type -> String -> Either Errors.Error Core.Term stringToTermE cx typ s = let readErr = err cx "failed to read value"- readAndWrap = \reader -> \wrapper -> Optionals.cases (reader s) readErr (\v -> Right (Core.TermLiteral (wrapper v)))+ readAndWrap = \reader -> \wrapper -> Optionals.match (reader s) readErr (\v -> Right (Core.TermLiteral (wrapper v))) in case (Strip.deannotateType typ) of Core.TypeLiteral v0 -> case v0 of Core.LiteralTypeBoolean -> readAndWrap (\x -> Literals.parseBoolean x) (\b -> Core.LiteralBoolean b)@@ -647,7 +647,7 @@ Core.IntegerValueUint64 v2 -> Literals.showUint64 v2) Core.LiteralString v1 -> Right v1 _ -> unexpectedE cx "boolean, integer, or string" "other literal"- Core.TermOptional v0 -> Optionals.cases v0 (unexpectedE cx "literal value" "Nothing") (\term_ -> termToStringE cx term_)+ Core.TermOptional v0 -> Optionals.match v0 (unexpectedE cx "literal value" "Nothing") (\term_ -> termToStringE cx term_) _ -> unexpectedE cx "literal value" "other" -- | Construct an error for unexpected values
src/main/haskell/Hydra/Avro/Encoder.hs view
@@ -176,13 +176,13 @@ (Coders.adapterTarget innerAd)])), Coders.adapterCoder = Coders.Coder { Coders.coderEncode = (\t -> case t of- Core.TermOptional v1 -> Optionals.cases v1 (Right Model.ValueNull) (\inner -> Coders.coderEncode (Coders.adapterCoder innerAd) inner)),+ Core.TermOptional v1 -> Optionals.match v1 (Right Model.ValueNull) (\inner -> Coders.coderEncode (Coders.adapterCoder innerAd) inner)), Coders.coderDecode = (\j -> case j of Model.ValueNull -> Right (Core.TermOptional Nothing) _ -> Eithers.map (\t -> Core.TermOptional (Just t)) (Coders.coderDecode (Coders.adapterCoder innerAd) j))}}, env1))) Core.TypeWrap v0 -> encodeTypeInner cx mName v0 env- Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 (Environment.encodeEnvironmentEmitted env)) (Optionals.cases (Maps.lookup v0 (Environment.encodeEnvironmentTypeMap env)) (err cx (Strings.concat2 "referenced type not found: " (Core.unName v0))) (\refType -> encodeTypeInner cx (Just v0) refType env)) (\existingAd -> Right (+ Core.TypeVariable v0 -> Optionals.match (Maps.lookup v0 (Environment.encodeEnvironmentEmitted env)) (Optionals.match (Maps.lookup v0 (Environment.encodeEnvironmentTypeMap env)) (err cx (Strings.concat2 "referenced type not found: " (Core.unName v0))) (\refType -> encodeTypeInner cx (Just v0) refType env)) (\existingAd -> Right ( Coders.Adapter { Coders.adapterIsLossy = (Coders.adapterIsLossy existingAd), Coders.adapterSource = (Coders.adapterSource existingAd),@@ -194,7 +194,7 @@ -- | Encode with full environment threading. Returns the adapter and updated environment encodeTypeWithEnv :: t0 -> Core.Name -> Environment.EncodeEnvironment -> Either Errors.Error (Coders.Adapter Core.Type Schema.Schema Core.Term Model.Value Errors.Error, Environment.EncodeEnvironment) encodeTypeWithEnv cx name_ env =- Optionals.cases (Maps.lookup name_ (Environment.encodeEnvironmentTypeMap env)) (err cx (Strings.concat2 "type not found in type map: " (Literals.printString (Core.unName name_)))) (\typ -> encodeTypeInner cx (Just name_) typ env)+ Optionals.match (Maps.lookup name_ (Environment.encodeEnvironmentTypeMap env)) (err cx (Strings.concat2 "type not found in type map: " (Literals.printString (Core.unName name_)))) (\typ -> encodeTypeInner cx (Just name_) typ env) -- | Adapter for all-unit union types (enums) enumAdapter :: t0 -> Core.Type -> Maybe Core.Name -> M.Map Core.Name Core.Term -> [Core.FieldType] -> Environment.EncodeEnvironment -> Either t1 (Coders.Adapter Core.Type Schema.Schema Core.Term Model.Value Errors.Error, Environment.EncodeEnvironment)@@ -432,7 +432,7 @@ namedTypeAdapter cx typ mName annotations fieldTypes env0 mkNamedType mkCoder = let typeName = Optionals.withDefault (typeToName typ) mName- in (Optionals.cases (Maps.lookup typeName (Environment.encodeEnvironmentEmitted env0)) (Eithers.bind (foldFieldAdapters cx fieldTypes env0) (\faResult ->+ in (Optionals.match (Maps.lookup typeName (Environment.encodeEnvironmentEmitted env0)) (Eithers.bind (foldFieldAdapters cx fieldTypes env0) (\faResult -> let fieldAdapters = Pairs.first faResult env1 = Pairs.second faResult avroFields = Lists.map buildAvroField fieldAdapters@@ -582,13 +582,13 @@ Model.ValueObject v0 -> let mm = Maps.fromList v0 findActive =- \remaining -> Optionals.cases (Lists.uncons remaining) (Left (Errors.ErrorOther (Errors.OtherError "no non-null field in union record"))) (\p ->+ \remaining -> Optionals.match (Lists.uncons remaining) (Left (Errors.ErrorOther (Errors.OtherError "no non-null field in union record"))) (\p -> let head_ = Pairs.first p rest_ = Pairs.second p fname = Pairs.first head_ ad = Pairs.second head_ mjv = Maps.lookup (localName fname) mm- in (Optionals.cases mjv (findActive rest_) (\jv -> case jv of+ in (Optionals.match mjv (findActive rest_) (\jv -> case jv of Model.ValueNull -> findActive rest_ _ -> Eithers.map (\t -> Core.TermInject (Core.Injection { Core.injectionTypeName = typeName,
src/main/haskell/Hydra/Avro/SchemaJson.hs view
@@ -178,7 +178,7 @@ -- | Decode aliases from a JSON object map decodeAliases :: t0 -> M.Map String Model.Value -> Either t1 (Maybe [String]) decodeAliases cx m =- Eithers.bind (optArrayE cx avroAliases m) (\mArr -> Optionals.cases mArr (Right Nothing) (\arr -> Eithers.map (\strs -> Optionals.pure strs) (Eithers.mapList (expectStringE cx) arr)))+ Eithers.bind (optArrayE cx avroAliases m) (\mArr -> Optionals.match mArr (Right Nothing) (\arr -> Eithers.map (\strs -> Optionals.pure strs) (Eithers.mapList (expectStringE cx) arr))) -- | Decode an Avro array schema from a JSON object map decodeArraySchema :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.Schema@@ -233,7 +233,7 @@ -- | Decode an Avro schema from a JSON object given the type name decodeObjectSchema :: t0 -> M.Map String Model.Value -> String -> Either Errors.Error Schema.Schema decodeObjectSchema cx m typeName =- Logic.ifElse (Equality.equal typeName "array") (decodeArraySchema cx m) (Logic.ifElse (Equality.equal typeName "map") (decodeMapSchema cx m) (Logic.ifElse (Equality.equal typeName "record") (decodeNamedSchema cx m (decodeRecord cx m)) (Logic.ifElse (Equality.equal typeName "enum") (decodeNamedSchema cx m (decodeEnum cx m)) (Logic.ifElse (Equality.equal typeName "fixed") (decodeNamedSchema cx m (decodeFixed cx m)) (Optionals.cases (decodePrimitiveName typeName) (err cx (Strings.concat [+ Logic.ifElse (Equality.equal typeName "array") (decodeArraySchema cx m) (Logic.ifElse (Equality.equal typeName "map") (decodeMapSchema cx m) (Logic.ifElse (Equality.equal typeName "record") (decodeNamedSchema cx m (decodeRecord cx m)) (Logic.ifElse (Equality.equal typeName "enum") (decodeNamedSchema cx m (decodeEnum cx m)) (Logic.ifElse (Equality.equal typeName "fixed") (decodeNamedSchema cx m (decodeFixed cx m)) (Optionals.match (decodePrimitiveName typeName) (err cx (Strings.concat [ "unknown type: ", typeName])) (\p -> Right (Schema.SchemaPrimitive p))))))) @@ -259,7 +259,7 @@ decodeSchema :: t0 -> Model.Value -> Either Errors.Error Schema.Schema decodeSchema cx v = case v of- Model.ValueString v0 -> Optionals.cases (decodePrimitiveName v0) (Right (Schema.SchemaReference v0)) (\p -> Right (Schema.SchemaPrimitive p))+ Model.ValueString v0 -> Optionals.match (decodePrimitiveName v0) (Right (Schema.SchemaReference v0)) (\p -> Right (Schema.SchemaPrimitive p)) Model.ValueArray v0 -> Eithers.map (\decoded -> Schema.SchemaUnion (Schema.Union decoded)) (Eithers.mapList (decodeSchema cx) v0) Model.ValueObject v0 -> let m = Maps.fromList v0@@ -287,7 +287,7 @@ ("type", (Model.ValueString "enum"))], [ ("symbols", (Model.ValueArray (Lists.map (\s -> Model.ValueString s) (Schema.enumSymbols e))))],- (Optionals.cases (Schema.enumDefault e) [] (\d -> [+ (Optionals.match (Schema.enumDefault e) [] (\d -> [ ("default", (Model.ValueString d))]))] -- | Encode an Avro field to a JSON object@@ -298,13 +298,13 @@ ("name", (Model.ValueString (Schema.fieldName f)))], [ ("type", (encodeSchema (Schema.fieldType f)))],- (Optionals.cases (Schema.fieldDoc f) [] (\d -> [+ (Optionals.match (Schema.fieldDoc f) [] (\d -> [ ("doc", (Model.ValueString d))])),- (Optionals.cases (Schema.fieldDefault f) [] (\d -> [+ (Optionals.match (Schema.fieldDefault f) [] (\d -> [ ("default", d)])),- (Optionals.cases (Schema.fieldOrder f) [] (\o -> [+ (Optionals.match (Schema.fieldOrder f) [] (\o -> [ encodeOrder o])),- (Optionals.cases (Schema.fieldAliases f) [] (\als -> [+ (Optionals.match (Schema.fieldAliases f) [] (\als -> [ ("aliases", (Model.ValueArray (Lists.map (\a -> Model.ValueString a) als)))])), (encodeAnnotations (Schema.fieldAnnotations f))]) @@ -328,11 +328,11 @@ Model.ValueObject (Lists.concat [ [ ("name", (Model.ValueString (Schema.namedName n)))],- (Optionals.cases (Schema.namedNamespace n) [] (\ns -> [+ (Optionals.match (Schema.namedNamespace n) [] (\ns -> [ ("namespace", (Model.ValueString ns))])),- (Optionals.cases (Schema.namedDoc n) [] (\d -> [+ (Optionals.match (Schema.namedDoc n) [] (\d -> [ ("doc", (Model.ValueString d))])),- (Optionals.cases (Schema.namedAliases n) [] (\als -> [+ (Optionals.match (Schema.namedAliases n) [] (\als -> [ ("aliases", (Model.ValueArray (Lists.map (\a -> Model.ValueString a) als)))])), (encodeNamedType (Schema.namedType n)), (encodeAnnotations (Schema.namedAnnotations n))])@@ -429,7 +429,7 @@ -- | Look up an optional array attribute in a JSON object map optArrayE :: Ord t1 => (t0 -> t1 -> M.Map t1 Model.Value -> Either t2 (Maybe [Model.Value])) optArrayE cx fname m =- Optionals.cases (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\a -> Optionals.pure a) (expectArrayE cx v))+ Optionals.match (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\a -> Optionals.pure a) (expectArrayE cx v)) -- | Look up an optional attribute in a JSON object map optE :: Ord t0 => (t0 -> M.Map t0 t1 -> Maybe t1)@@ -438,7 +438,7 @@ -- | Look up an optional string attribute in a JSON object map optStringE :: Ord t1 => (t0 -> t1 -> M.Map t1 Model.Value -> Either t2 (Maybe String)) optStringE cx fname m =- Optionals.cases (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\s -> Optionals.pure s) (expectStringE cx v))+ Optionals.match (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\s -> Optionals.pure s) (expectStringE cx v)) -- | Look up a required array attribute in a JSON object map requireArrayE :: t0 -> String -> M.Map String Model.Value -> Either Errors.Error [Model.Value]@@ -447,7 +447,7 @@ -- | Look up a required attribute in a JSON object map requireE :: t0 -> String -> M.Map String t1 -> Either Errors.Error t1 requireE cx fname m =- Optionals.cases (Maps.lookup fname m) (err cx (Strings.concat [+ Optionals.match (Maps.lookup fname m) (err cx (Strings.concat [ "required attribute ", (Literals.printString fname), " not found"])) (\v -> Right v)
src/main/haskell/Hydra/Cpp/Names.hs view
@@ -80,7 +80,7 @@ cppLocal = sanitizeCppName (Formatting.convertCase Util.CaseConventionCamel conv local) cppNs = \nsVal -> Strings.join "::" (Lists.map (Formatting.convertCase Util.CaseConventionCamel Util.CaseConventionLowerSnake) (Strings.splitOn "." (Packaging.unModuleName nsVal)))- in (Logic.ifElse isQualified (Optionals.cases (Maps.lookup name boundVars) (Optionals.cases mns cppLocal (\nsVal -> Strings.concat2 (cppNs nsVal) (Strings.concat2 "::" cppLocal))) (\n -> n)) cppLocal)+ in (Logic.ifElse isQualified (Optionals.match (Maps.lookup name boundVars) (Optionals.match mns cppLocal (\nsVal -> Strings.concat2 (cppNs nsVal) (Strings.concat2 "::" cppLocal))) (\n -> n)) cppLocal) -- | Encode a qualified name with namespace encodeNameQualified :: Environment.CppEnvironment -> Core.Name -> String@@ -91,7 +91,7 @@ qualName = Names.qualifyName name mns = Util.qualifiedNameModuleName qualName local = Util.qualifiedNameLocal qualName- in (Optionals.cases (Maps.lookup name boundVars) (Logic.ifElse (Equality.equal mns (Just focusNs)) (sanitizeCppName local) (Strings.join "::" (Lists.map sanitizeCppName (Strings.splitOn "." (Core.unName name))))) (\n -> n))+ in (Optionals.match (Maps.lookup name boundVars) (Logic.ifElse (Equality.equal mns (Just focusNs)) (sanitizeCppName local) (Strings.join "::" (Lists.map sanitizeCppName (Strings.splitOn "." (Core.unName name))))) (\n -> n)) -- | Encode a namespace as a C++ namespace string encodeNamespace :: Packaging.ModuleName -> String
src/main/haskell/Hydra/Cpp/Serde.hs view
@@ -312,9 +312,9 @@ [ Serialization.cst "#define", (Serialization.cst name)],- (Optionals.cases params [] (\ps -> [+ (Optionals.match params [] (\ps -> [ Serialization.parenListAdaptive (Lists.map (\p -> Serialization.cst p) ps)])),- (Optionals.cases replacement [] (\r -> [+ (Optionals.match replacement [] (\r -> [ Serialization.cst r]))])) -- | Convert a destructor declaration to an expression@@ -655,7 +655,7 @@ in (Serialization.spaceSep [ captureListToExpr captures, (Logic.ifElse (Lists.null params) (Serialization.parens (Serialization.cst "")) (Serialization.parenListAdaptive (Lists.map parameterToExpr params))),- (Optionals.cases retType (Serialization.cst "") (\t -> Serialization.spaceSep [+ (Optionals.match retType (Serialization.cst "") (\t -> Serialization.spaceSep [ Serialization.cst "->", (typeExpressionToExpr t)])), (compoundStatementToExpr body)])@@ -703,7 +703,7 @@ [ Serialization.cst "#line", (Serialization.cst (Literals.showInt32 lineNumber))],- (Optionals.cases filename [] (\f -> [+ (Optionals.match filename [] (\f -> [ Serialization.cst (Strings.concat [ "\"", f,@@ -892,7 +892,7 @@ Serialization.cst "std::optional<", (typeExpressionToExpr valType), (Serialization.cst ">"),- (Optionals.cases val (Serialization.cst "{}") (\v -> Serialization.curlyBracesList Nothing Serialization.inlineStyle [+ (Optionals.match val (Serialization.cst "{}") (\v -> Serialization.curlyBracesList Nothing Serialization.inlineStyle [ expressionToExpr v]))]) -- | Convert overloaded lambdas to an expression@@ -919,7 +919,7 @@ [ typeExpressionToExpr typ, nameExpr],- (Optionals.cases defaultVal [] (\expr -> [+ (Optionals.match defaultVal [] (\expr -> [ Serialization.cst "=", (expressionToExpr expr)]))])) @@ -1089,7 +1089,7 @@ Serialization.cst "if", (Serialization.parens (expressionToExpr cond))], (statementToExpr thenBranch),- (Optionals.cases elseBranch (Serialization.cst "") (\stmt -> Serialization.newlineSep [+ (Optionals.match elseBranch (Serialization.cst "") (\stmt -> Serialization.newlineSep [ Serialization.cst "else", (statementToExpr stmt)]))]) @@ -1161,11 +1161,11 @@ switchStatementToExpr ss = let value = Syntax.switchStatementValue ss- cases = Syntax.switchStatementCases ss+ match = Syntax.switchStatementCases ss in (Serialization.spaceSep [ Serialization.cst "switch", (Serialization.parens (expressionToExpr value)),- (Serialization.curlyBlock Serialization.fullBlockStyle (Serialization.newlineSep (Lists.map caseStatementToExpr cases)))])+ (Serialization.curlyBlock Serialization.fullBlockStyle (Serialization.newlineSep (Lists.map caseStatementToExpr match)))]) -- | Convert a template argument to an expression templateArgumentToExpr :: Syntax.TemplateArgument -> Ast.Expr@@ -1306,11 +1306,11 @@ terminator = Logic.ifElse commas Serialization.withComma Serialization.withSemi in (terminator (Serialization.spaceSep (Lists.concat [ Logic.ifElse isAuto [- Serialization.cst "auto"] (Optionals.cases typ [] (\t -> [+ Serialization.cst "auto"] (Optionals.match typ [] (\t -> [ typeExpressionToExpr t])), [ Serialization.cst name],- (Optionals.cases init [] (\expr -> [+ (Optionals.match init [] (\expr -> [ Serialization.cst "=", (expressionToExpr expr)]))])))
src/main/haskell/Hydra/Graphql/Coder.hs view
@@ -41,6 +41,7 @@ import qualified Hydra.Query as Query import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational+import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Serialization as Serialization import qualified Hydra.Strip as Strip import qualified Hydra.System as System@@ -136,14 +137,8 @@ Core.FieldType { Core.fieldTypeName = (Core.Name "second"), Core.fieldTypeType = (Core.pairTypeSecond v0)}])- Core.TypeList v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = (Core.TypeList v0)}])- Core.TypeSet v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = (Core.TypeList v0)}])+ Core.TypeList v0 -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord (Core.TypeList v0))+ Core.TypeSet v0 -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord (Core.TypeList v0)) Core.TypeMap v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [ Core.FieldType { Core.fieldTypeName = (Core.Name "key"),@@ -151,22 +146,10 @@ Core.FieldType { Core.fieldTypeName = (Core.Name "value"), Core.fieldTypeType = (Core.mapTypeValues v0)}])- Core.TypeLiteral v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = (Core.TypeLiteral v0)}])- Core.TypeVariable v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = (Core.TypeVariable v0)}])- Core.TypeWrap v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = v0}])- Core.TypeUnit -> encodeNamedType cx g prefixes name (Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeBoolean)}])+ Core.TypeLiteral v0 -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord (Core.TypeLiteral v0))+ Core.TypeVariable v0 -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord (Core.TypeVariable v0))+ Core.TypeWrap v0 -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord v0)+ Core.TypeUnit -> encodeNamedType cx g prefixes name (Rewriting.wrapTypeToRecord (Core.TypeLiteral Core.LiteralTypeBoolean)) Core.TypeForall v0 -> encodeNamedType cx g prefixes name (Core.forallTypeBody v0) Core.TypeApplication v0 -> encodeNamedType cx g prefixes name (Core.applicationTypeFunction v0) Core.TypeFunction v0 -> encodeNamedType cx g prefixes name (Core.TypeRecord [@@ -226,7 +209,7 @@ let qualName = Names.qualifyName name local = Util.qualifiedNameLocal qualName mns = Util.qualifiedNameModuleName qualName- prefix = Optionals.cases mns "" (\ns_ -> Optionals.cases (Maps.lookup ns_ prefixes) "" (\p -> p))+ prefix = Optionals.match mns "" (\ns_ -> Optionals.match (Maps.lookup ns_ prefixes) "" (\p -> p)) in (Syntax.Name (Strings.concat2 prefix (sanitize local))) -- | Encode a union variant field type to a nullable GraphQL FieldDefinition. Unit-typed variants become Boolean fields; data-carrying variants use their actual type, made nullable.
src/main/haskell/Hydra/Graphql/Serde.hs view
@@ -69,7 +69,7 @@ let desc = Syntax.enumTypeDefinitionDescription def name = Syntax.enumTypeDefinitionName def values = Syntax.enumTypeDefinitionEnumValuesDefinition def- valuesExpr = Optionals.cases values [] (\vs -> Lists.map enumValueDefinitionToExpr (Syntax.unEnumValuesDefinition vs))+ valuesExpr = Optionals.match values [] (\vs -> Lists.map enumValueDefinitionToExpr (Syntax.unEnumValuesDefinition vs)) in (withDescription desc (Serialization.spaceSep [ Serialization.cst "enum", (nameToExpr name),@@ -138,7 +138,7 @@ let desc = Syntax.objectTypeDefinitionDescription def name = Syntax.objectTypeDefinitionName def fields = Syntax.objectTypeDefinitionFieldsDefinition def- fieldsExpr = Optionals.cases fields [] (\fs -> Lists.map fieldDefinitionToExpr (Syntax.unFieldsDefinition fs))+ fieldsExpr = Optionals.match fields [] (\fs -> Lists.map fieldDefinitionToExpr (Syntax.unFieldsDefinition fs)) in (withDescription desc (Serialization.spaceSep [ Serialization.cst "type", (nameToExpr name),
src/main/haskell/Hydra/Json/Schema/Coder.hs view
@@ -184,7 +184,7 @@ let qn = Names.qualifyName name mns = Util.qualifiedNameModuleName qn local = Util.qualifiedNameLocal qn- nsPart = Optionals.cases mns "" (\ns -> Strings.concat2 (Packaging.unModuleName ns) ".")+ nsPart = Optionals.match mns "" (\ns -> Strings.concat2 (Packaging.unModuleName ns) ".") in (Names.moduleNameToFilePath Util.CaseConventionCamel (File.FileExtension "json") (Packaging.ModuleName (Strings.concat2 nsPart local))) -- | Build the JSON Schema restriction list for a pair type@@ -218,7 +218,7 @@ step = \acc -> \n -> Logic.ifElse (Sets.member n acc) acc ( let acc1 = Sets.insert n acc- in (Optionals.cases (Maps.lookup n typeMap) acc1 (\t -> transitiveTypeDeps typeMap acc1 t)))+ in (Optionals.match (Maps.lookup n typeMap) acc1 (\t -> transitiveTypeDeps typeMap acc1 t))) in (Lists.foldl step visited (Sets.toList directDeps)) -- | Build a JSON Schema document for a single named type, with $defs covering its transitive dependencies and short-name substitution applied@@ -246,7 +246,7 @@ typeToExpr :: t0 -> Graph.Graph -> Bool -> Core.Type -> Either Errors.Error [SchemaModel.Restriction] typeToExpr cx g optional typ = case typ of- Core.TypeAnnotated _ -> Eithers.bind (typeToExpr cx g optional (Strip.deannotateType typ)) (\res -> Eithers.bind (Annotations.getTypeDescription cx g typ) (\mdesc -> Right (Lists.concat2 (Optionals.cases mdesc [] (\d -> [+ Core.TypeAnnotated _ -> Eithers.bind (typeToExpr cx g optional (Strip.deannotateType typ)) (\res -> Eithers.bind (Annotations.getTypeDescription cx g typ) (\mdesc -> Right (Lists.concat2 (Optionals.match mdesc [] (\d -> [ SchemaModel.RestrictionDescription d])) res))) Core.TypeApplication v0 -> typeToExpr cx g optional (Core.applicationTypeFunction v0) Core.TypeEither v0 ->
src/main/haskell/Hydra/Pegasus/Coder.hs view
@@ -65,7 +65,7 @@ constructModule cx g aliases mod typeDefs = let groups = Dependencies.topologicalSortTypeDefinitions typeDefs- in (Optionals.cases (Lists.find (\grp -> Ordering.gt (Lists.length grp) 1) groups) (+ in (Optionals.match (Lists.find (\grp -> Ordering.gt (Lists.length grp) 1) groups) ( let sortedDefs = Lists.concat groups in (Eithers.bind (Eithers.mapList (\typeDef -> typeToSchema cx g aliases mod typeDef) sortedDefs) (\schemas -> Right (Maps.fromList (Lists.map (toPair mod aliases) schemas))))) (\cycle -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "types form a cycle (unsupported in PDL): [" (Strings.concat2 (Strings.join ", " (Lists.map (\td -> Core.unName (Packaging.typeDefinitionName td)) cycle)) "]"))))))
src/main/haskell/Hydra/Protobuf/Coder.hs view
@@ -113,7 +113,7 @@ descOption = Proto3.Option { Proto3.optionName = Serde.descriptionOptionName,- Proto3.optionValue = (Proto3.ValueString (Strings.concat2 (Optionals.cases desc "" (\d -> Strings.concat2 d "\n\n")) Constants.warningAutoGeneratedFile))}+ Proto3.optionValue = (Proto3.ValueString (Strings.concat2 (Optionals.match desc "" (\d -> Strings.concat2 d "\n\n")) Constants.warningAutoGeneratedFile))} checkFieldType_wrapper = \typ -> case (Strip.deannotateType typ) of Core.TypeOptional v0 -> case (Strip.deannotateType v0) of@@ -124,7 +124,7 @@ checkFields = \checkType -> \checkFieldType -> \ts -> Lists.foldl (\b -> \t -> Logic.or b (Rewriting.foldOverType Coders.TraversalOrderPre (\b2 -> \t2 -> Logic.or b2 ( let checkResult = checkType t2- in (Optionals.cases checkResult (case t2 of+ in (Optionals.match checkResult (case t2 of Core.TypeRecord v0 -> Lists.foldl (\b3 -> \f -> Logic.or b3 (checkFieldType (Strip.deannotateType (Core.fieldTypeType f)))) False v0 Core.TypeUnion v0 -> Lists.foldl (\b3 -> \f -> Logic.or b3 (checkFieldType (Strip.deannotateType (Core.fieldTypeType f)))) False v0 _ -> False) (\b3 -> b3)))) False t)) False ts@@ -164,17 +164,12 @@ ProtobufEnvironment.EncoderState { ProtobufEnvironment.encoderStateContext = (ProtobufEnvironment.encoderStateContext cx1), ProtobufEnvironment.encoderStateFieldIndex = (Math.add (ProtobufEnvironment.encoderStateFieldIndex cx1) 1)})- wrapAsRecordType =- \t -> Core.TypeRecord [- Core.FieldType {- Core.fieldTypeName = (Core.Name "value"),- Core.fieldTypeType = t}] toEitherString = \result -> result encode = \cx0 -> \options -> \t -> case (simplifyType t) of Core.TypeRecord v0 -> Eithers.map (\md -> Proto3.DefinitionMessage md) (toEitherString (encodeRecordType cx0 g localNs options name v0))- Core.TypeUnion v0 -> Logic.ifElse (isEnumDefinition t) (Eithers.map (\ed -> Proto3.DefinitionEnum ed) (toEitherString (encodeEnumDefinition cx0 g options name v0))) (encode cx0 options (wrapAsRecordType (Core.TypeUnion v0)))- _ -> encode cx0 options (wrapAsRecordType t)+ Core.TypeUnion v0 -> Logic.ifElse (isEnumDefinition t) (Eithers.map (\ed -> Proto3.DefinitionEnum ed) (toEitherString (encodeEnumDefinition cx0 g options name v0))) (encode cx0 options (Rewriting.wrapTypeToRecord (Core.TypeUnion v0)))+ _ -> encode cx0 options (Rewriting.wrapTypeToRecord t) in (Eithers.bind (toEitherString (findOptions cx g typ)) (\options -> encode cx2 options typ)) -- | Encode a Hydra union type as a Protobuf enum definition@@ -194,7 +189,7 @@ Proto3.enumValueName = (encodeEnumValueName tname fname), Proto3.enumValueNumber = idx, Proto3.enumValueOptions = opts})))- indices = Math.range 1 (Lists.length fts)+ indices = Math.range 1 (Math.add (Lists.length fts) 1) in (Eithers.bind (Eithers.mapList (\p -> encodeEnumField (Pairs.first p) (Pairs.second p)) (Lists.zip fts indices)) (\values -> Right (Proto3.EnumDefinition { Proto3.enumDefinitionName = (encodeTypeName tname), Proto3.enumDefinitionValues = (Lists.cons unspecifiedField values),@@ -351,7 +346,7 @@ local = Util.qualifiedNameLocal qn ns_ = Util.qualifiedNameModuleName qn localNsParts = Optionals.withDefault [] (Lists.init (Strings.splitOn "." (Packaging.unModuleName localNs)))- in (Proto3.TypeName (Optionals.cases ns_ local (\nsVal ->+ in (Proto3.TypeName (Optionals.match ns_ local (\nsVal -> let nsParts = Optionals.withDefault [] (Lists.init (Strings.splitOn "." (Packaging.unModuleName nsVal))) in (Logic.ifElse (Equality.equal nsParts localNsParts) local (Strings.join "." (Lists.concat [ nsParts,@@ -527,7 +522,7 @@ -- | Read a boolean annotation from a type readBooleanAnnotation :: t0 -> Graph.Graph -> Core.Name -> Core.Type -> Either Errors.Error Bool readBooleanAnnotation cx g key typ =- Optionals.cases (Maps.lookup key (Annotations.typeAnnotationInternal typ)) (Right False) (\term -> ExtractCore.boolean g term)+ Optionals.match (Maps.lookup key (Annotations.typeAnnotationInternal typ)) (Right False) (\term -> ExtractCore.boolean g term) -- | Simplify a type by removing annotations and unwrapping newtypes simplifyType :: Core.Type -> Core.Type
src/main/haskell/Hydra/Protobuf/Serde.hs view
@@ -203,14 +203,14 @@ optDesc doubleNewline opts expr = let descs = Lists.filter (\opt -> Equality.equal (Proto3.optionName opt) "_description") opts- in (Optionals.cases (Lists.head descs) expr (\firstDesc ->+ in (Optionals.match (Lists.head descs) expr (\firstDesc -> let descValue = Proto3.optionValue firstDesc descStr = case descValue of Proto3.ValueBoolean v0 -> Logic.ifElse v0 "true" "false" Proto3.ValueString v0 -> v0 commentLines =- Lists.map (\line -> Logic.ifElse (Equality.equal line "") "//" (Strings.concat2 "// " line)) (Strings.lines descStr)+ Lists.map (\line -> Logic.ifElse (Equality.equal line "") "//" (Strings.concat2 "// " line)) (Formatting.lines descStr) comment = Serialization.cst (Strings.join "\n" commentLines) sep = Logic.ifElse doubleNewline (Serialization.doubleNewlineSep [
src/main/haskell/Hydra/Rust/Coder.hs view
@@ -154,7 +154,7 @@ encodeProjectionElim cx g proj marg = let fname = Formatting.convertCaseCamelToLowerSnake (Core.unName (Core.projectionFieldName proj))- in (Optionals.cases marg (Right (rustClosure [+ in (Optionals.match marg (Right (rustClosure [ "v"] (Syntax.ExpressionFieldAccess (Syntax.FieldAccessExpr { Syntax.fieldAccessExprObject = (rustExprPath "v"), Syntax.fieldAccessExprField = fname})))) (\arg -> Eithers.bind (encodeTerm cx g arg) (\sarg -> Right (Syntax.ExpressionFieldAccess (Syntax.FieldAccessExpr {@@ -203,7 +203,7 @@ k, v])))) (Maps.toList v0)) (\pairs -> Right (rustCall (rustExprPath "BTreeMap::from") [ Syntax.ExpressionArray (Syntax.ArrayExprElements pairs)]))- Core.TermOptional v0 -> Optionals.cases v0 (Right (rustExprPath "None")) (\val -> Eithers.bind (encodeTerm cx g val) (\sval -> Right (rustCall (rustExprPath "Some") [+ Core.TermOptional v0 -> Optionals.match v0 (Right (rustExprPath "None")) (\val -> Eithers.bind (encodeTerm cx g val) (\sval -> Right (rustCall (rustExprPath "Some") [ sval]))) Core.TermPair v0 -> Eithers.bind (encodeTerm cx g (Pairs.first v0)) (\f -> Eithers.bind (encodeTerm cx g (Pairs.second v0)) (\s -> Right (Syntax.ExpressionTuple [ f,@@ -255,7 +255,7 @@ term = Packaging.termDefinitionBody tdef lname = Formatting.convertCaseCamelToLowerSnake (Names.localNameOf name) typ =- Optionals.cases (Optionals.map Scoping.termSignatureToTypeScheme (Packaging.termDefinitionSignature tdef)) (Core.TypeVariable (Core.Name "hydra.core.Unit")) Core.typeSchemeBody+ Optionals.match (Optionals.map Scoping.termSignatureToTypeScheme (Packaging.termDefinitionSignature tdef)) (Core.TypeVariable (Core.Name "hydra.core.Unit")) Core.typeSchemeBody in (Eithers.bind (encodeTerm cx g term) (\body -> Eithers.bind (encodeType cx g typ) (\retType -> Right (Syntax.ItemWithComments { Syntax.itemWithCommentsDoc = Nothing, Syntax.itemWithCommentsVisibility = Syntax.VisibilityPublic,@@ -387,13 +387,13 @@ Syntax.identifierPatternMutable = False, Syntax.identifierPatternAtPattern = Nothing})]})), Syntax.matchArmGuard = Nothing,- Syntax.matchArmBody = armBody})))) caseFields) (\arms -> Eithers.bind (Optionals.cases defCase (Right arms) (\dt -> Eithers.bind (encodeTerm cx g (Core.TermApplication (Core.Application {+ Syntax.matchArmBody = armBody})))) caseFields) (\arms -> Eithers.bind (Optionals.match defCase (Right arms) (\dt -> Eithers.bind (encodeTerm cx g (Core.TermApplication (Core.Application { Core.applicationFunction = dt, Core.applicationArgument = (Core.TermVariable (Core.Name "v"))}))) (\defBody -> Right (Lists.concat2 arms [ Syntax.MatchArm { Syntax.matchArmPattern = Syntax.PatternWildcard, Syntax.matchArmGuard = Nothing,- Syntax.matchArmBody = defBody}])))) (\allArms -> Optionals.cases marg (Right (rustClosure [+ Syntax.matchArmBody = defBody}])))) (\allArms -> Optionals.match marg (Right (rustClosure [ "v"] (Syntax.ExpressionMatch (Syntax.MatchExpr { Syntax.matchExprScrutinee = (rustExprPath "v"), Syntax.matchExprArms = allArms})))) (\arg -> Eithers.bind (encodeTerm cx g arg) (\sarg -> Right (Syntax.ExpressionMatch (Syntax.MatchExpr {@@ -403,7 +403,7 @@ -- | Encode a Hydra wrap elimination (unwrap) as a Rust expression. Takes an optional argument for applied unwraps. encodeUnwrapElim :: t0 -> t1 -> Core.Name -> Maybe Core.Term -> Either Errors.Error Syntax.Expression encodeUnwrapElim cx g name marg =- Optionals.cases marg (Right (rustClosure [+ Optionals.match marg (Right (rustClosure [ "v"] (Syntax.ExpressionTupleIndex (Syntax.TupleIndexExpr { Syntax.tupleIndexExprTuple = (rustExprPath "v"), Syntax.tupleIndexExprIndex = 0})))) (\arg -> Eithers.bind (encodeTerm cx g arg) (\sarg -> Right (Syntax.ExpressionTupleIndex (Syntax.TupleIndexExpr {
src/main/haskell/Hydra/Rust/Serde.hs view
@@ -16,6 +16,7 @@ import qualified Hydra.Error.System as ErrorSystem import qualified Hydra.Errors as Errors import qualified Hydra.File as File+import qualified Hydra.Formatting as Formatting import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as Model import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality@@ -82,7 +83,7 @@ prefix = Logic.ifElse inner "#![" "#[" pathStr = Strings.join "::" path tokensPart =- Optionals.cases tokens "" (\t -> Strings.concat [+ Optionals.match tokens "" (\t -> Strings.concat [ "(", t, ")"])@@ -134,7 +135,7 @@ let stmts = Syntax.blockStatements b expr = Syntax.blockExpression b stmtExprs = Lists.map statementToExpr stmts- exprPart = Optionals.cases expr [] (\e -> [+ exprPart = Optionals.match expr [] (\e -> [ expressionToExpr e]) allParts = Lists.concat2 stmtExprs exprPart in (Serialization.curlyBracesList Nothing Serialization.halfBlockStyle allParts)@@ -175,7 +176,7 @@ (Strings.join ", " (Lists.map closureParamToStr params)), "|"] retPart =- Optionals.cases retType Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match retType Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst "->", (typeToExpr t)])) in (Serialization.spaceSep (Optionals.givens [@@ -191,7 +192,7 @@ let pat = Syntax.closureParamPattern cp typ = Syntax.closureParamType cp patStr = Serialization.printExpr (patternToExpr pat)- in (Optionals.cases typ patStr (\t -> Strings.concat [+ in (Optionals.match typ patStr (\t -> Strings.concat [ patStr, ": ", (Serialization.printExpr (typeToExpr t))]))@@ -258,18 +259,18 @@ derives = Syntax.enumDefDerives e docC = Syntax.enumDefDoc e derivesAttr = derivesToExpr derives- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) header = Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "enum"), (Just (Serialization.cst name)), (genericParamsToExpr generics)])- wherePart = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ wherePart = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) body = Serialization.curlyBracesList Nothing Serialization.halfBlockStyle (Lists.map enumVariantToExpr variants) in (Serialization.newlineSep (Lists.concat [ docPart,- (Optionals.cases derivesAttr [] (\d -> [+ (Optionals.match derivesAttr [] (\d -> [ d])), [ Serialization.spaceSep (Optionals.givens [@@ -292,7 +293,7 @@ let name = Syntax.enumVariantName v body = Syntax.enumVariantBody v docC = Syntax.enumVariantDoc v- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) in (Serialization.newlineSep (Lists.concat [ docPart,@@ -337,10 +338,10 @@ Syntax.ExpressionArray v0 -> arrayExprToExpr v0 Syntax.ExpressionIndex v0 -> indexExprToExpr v0 Syntax.ExpressionRange v0 -> rangeExprToExpr v0- Syntax.ExpressionReturn v0 -> Optionals.cases v0 (Serialization.cst "return") (\e -> Serialization.spaceSep [+ Syntax.ExpressionReturn v0 -> Optionals.match v0 (Serialization.cst "return") (\e -> Serialization.spaceSep [ Serialization.cst "return", (expressionToExpr e)])- Syntax.ExpressionBreak v0 -> Optionals.cases v0 (Serialization.cst "break") (\e -> Serialization.spaceSep [+ Syntax.ExpressionBreak v0 -> Optionals.match v0 (Serialization.cst "break") (\e -> Serialization.spaceSep [ Serialization.cst "break", (expressionToExpr e)]) Syntax.ExpressionContinue -> Serialization.cst "continue"@@ -370,7 +371,7 @@ let name = Syntax.fieldPatternName fp pat = Syntax.fieldPatternPattern fp- in (Optionals.cases pat (Serialization.cst name) (\p -> Serialization.spaceSep [+ in (Optionals.match pat (Serialization.cst name) (\p -> Serialization.spaceSep [ Serialization.cst (Strings.concat2 name ":"), (patternToExpr p)])) @@ -380,7 +381,7 @@ let name = Syntax.fieldValueName fv val = Syntax.fieldValueValue fv- in (Optionals.cases val (Serialization.cst name) (\v -> Serialization.spaceSep [+ in (Optionals.match val (Serialization.cst name) (\v -> Serialization.spaceSep [ Serialization.cst (Strings.concat2 name ":"), (expressionToExpr v)])) @@ -391,7 +392,7 @@ let val = Syntax.floatLiteralValue fl suf = Syntax.floatLiteralSuffix fl valStr = Literals.showFloat64 val- sufStr = Optionals.cases suf "" (\s -> s)+ sufStr = Optionals.match suf "" (\s -> s) in (Serialization.cst (Strings.concat2 valStr sufStr)) -- | Serialize a function definition@@ -408,7 +409,7 @@ isConst = Syntax.fnDefConst f isUnsafe = Syntax.fnDefUnsafe f docC = Syntax.fnDefDoc f- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) asyncKw = Logic.ifElse isAsync (Just (Serialization.cst "async")) Nothing constKw = Logic.ifElse isConst (Just (Serialization.cst "const")) Nothing@@ -418,10 +419,10 @@ genericsExpr = genericParamsToExpr generics paramsExpr = Serialization.parenListAdaptive (Lists.map fnParamToExpr params) retTypeExpr =- Optionals.cases retType Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match retType Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst "->", (typeToExpr t)]))- whereExpr = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ whereExpr = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) header = Serialization.spaceSep (Optionals.givens [ asyncKw,@@ -459,7 +460,7 @@ iter = Syntax.forExprIter f body = Syntax.forExprBody f labelPart =- Optionals.cases label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":"))))+ Optionals.match label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":")))) in (Serialization.spaceSep (Optionals.givens [ labelPart, (Just (Serialization.cst "for")),@@ -496,7 +497,7 @@ output = Syntax.parenthesizedArgsOutput v0 inputPart = Serialization.parenListAdaptive (Lists.map typeToExpr inputs) outputPart =- Optionals.cases output Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match output Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst "->", (typeToExpr t)])) in (Just (Serialization.spaceSep (Optionals.givens [@@ -527,7 +528,7 @@ atPat = Syntax.identifierPatternAtPattern ip mutKw = Logic.ifElse mut (Just (Serialization.cst "mut")) Nothing atPart =- Optionals.cases atPat Nothing (\p -> Just (Serialization.spaceSep [+ Optionals.match atPat Nothing (\p -> Just (Serialization.spaceSep [ Serialization.cst "@", (patternToExpr p)])) in (Serialization.spaceSep (Optionals.givens [@@ -554,7 +555,7 @@ (Serialization.cst "="), (expressionToExpr expr)]) elsePart =- Optionals.cases elseB Nothing (\e -> Just (Serialization.spaceSep [+ Optionals.match elseB Nothing (\e -> Just (Serialization.spaceSep [ Serialization.cst "else", (expressionToExpr e)])) in (Serialization.spaceSep (Optionals.givens [@@ -574,10 +575,10 @@ items = Syntax.implBlockItems i genericsExpr = genericParamsToExpr generics traitPart =- Optionals.cases trait Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match trait Nothing (\t -> Just (Serialization.spaceSep [ typePathToExpr t, (Serialization.cst "for")]))- wherePart = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ wherePart = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) header = Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "impl"),@@ -610,16 +611,16 @@ body = Syntax.implMethodBody m pub = Syntax.implMethodPublic m docC = Syntax.implMethodDoc m- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) pubKw = Logic.ifElse pub (Just (Serialization.cst "pub")) Nothing genericsExpr = genericParamsToExpr generics paramsExpr = Serialization.parenListAdaptive (Lists.map methodParamToExpr params) retTypeExpr =- Optionals.cases retType Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match retType Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst "->", (typeToExpr t)]))- whereExpr = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ whereExpr = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) header = Serialization.spaceSep (Optionals.givens [ pubKw,@@ -655,7 +656,7 @@ let val = Syntax.integerLiteralValue il suf = Syntax.integerLiteralSuffix il valStr = Literals.showBigint val- sufStr = Optionals.cases suf "" (\s -> s)+ sufStr = Optionals.match suf "" (\s -> s) in (Serialization.cst (Strings.concat2 valStr sufStr)) -- | Serialize a Rust item to an AST expression@@ -681,7 +682,7 @@ let doc = Syntax.itemWithCommentsDoc iwc vis = Syntax.itemWithCommentsVisibility iwc item = Syntax.itemWithCommentsItem iwc- docPart = Optionals.cases doc [] (\d -> [+ docPart = Optionals.match doc [] (\d -> [ Serialization.cst (toRustDocComment d)]) visPart = visibilityToExpr vis itemPart = itemToExpr item@@ -702,11 +703,11 @@ init = Syntax.letStatementInit l mutKw = Logic.ifElse mut (Just (Serialization.cst "mut")) Nothing typPart =- Optionals.cases typ Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match typ Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst ":", (typeToExpr t)])) initPart =- Optionals.cases init Nothing (\e -> Just (Serialization.spaceSep [+ Optionals.match init Nothing (\e -> Just (Serialization.spaceSep [ Serialization.cst "=", (expressionToExpr e)])) in (Serialization.spaceSep (Optionals.givens [@@ -746,7 +747,7 @@ let label = Syntax.loopExprLabel l body = Syntax.loopExprBody l labelPart =- Optionals.cases label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":"))))+ Optionals.match label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":")))) in (Serialization.spaceSep (Optionals.givens [ labelPart, (Just (Serialization.cst "loop")),@@ -785,7 +786,7 @@ guard = Syntax.matchArmGuard arm body = Syntax.matchArmBody arm guardPart =- Optionals.cases guard Nothing (\g -> Just (Serialization.spaceSep [+ Optionals.match guard Nothing (\g -> Just (Serialization.spaceSep [ Serialization.cst "if", (expressionToExpr g)])) in (Serialization.spaceSep (Optionals.givens [@@ -844,7 +845,7 @@ let name = Syntax.modDefName m body = Syntax.modDefBody m- in (Optionals.cases body (Serialization.spaceSep [+ in (Optionals.match body (Serialization.spaceSep [ Serialization.cst "mod", (Serialization.cst name), (Serialization.cst ";")]) (\items -> Serialization.spaceSep [@@ -887,8 +888,8 @@ let from = Syntax.rangeExprFrom r to = Syntax.rangeExprTo r incl = Syntax.rangeExprInclusive r- fromStr = Optionals.cases from "" (\f -> Serialization.printExpr (expressionToExpr f))- toStr = Optionals.cases to "" (\t -> Serialization.printExpr (expressionToExpr t))+ fromStr = Optionals.match from "" (\f -> Serialization.printExpr (expressionToExpr f))+ toStr = Optionals.match to "" (\t -> Serialization.printExpr (expressionToExpr t)) op = Logic.ifElse incl "..=" ".." in (Serialization.cst (Strings.concat [ fromStr,@@ -902,8 +903,8 @@ let from = Syntax.rangePatternFrom rp to = Syntax.rangePatternTo rp incl = Syntax.rangePatternInclusive rp- fromStr = Optionals.cases from "" (\p -> Serialization.printExpr (patternToExpr p))- toStr = Optionals.cases to "" (\p -> Serialization.printExpr (patternToExpr p))+ fromStr = Optionals.match from "" (\p -> Serialization.printExpr (patternToExpr p))+ toStr = Optionals.match to "" (\p -> Serialization.printExpr (patternToExpr p)) op = Logic.ifElse incl "..=" ".." in (Serialization.cst (Strings.concat [ fromStr,@@ -935,7 +936,7 @@ let lt = Syntax.referenceTypeLifetime rt mut = Syntax.referenceTypeMutable rt t = Syntax.referenceTypeType rt- ltPart = Optionals.cases lt "" (\l -> Strings.concat2 "'" (Strings.concat2 (Syntax.lifetimeName l) " "))+ ltPart = Optionals.match lt "" (\l -> Strings.concat2 "'" (Strings.concat2 (Syntax.lifetimeName l) " ")) mutPart = Logic.ifElse mut "mut " "" in (Serialization.cst (Strings.concat [ "&",@@ -993,17 +994,17 @@ derives = Syntax.structDefDerives s docC = Syntax.structDefDoc s derivesAttr = derivesToExpr derives- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) header = Serialization.spaceSep (Optionals.givens [ Just (Serialization.cst "struct"), (Just (Serialization.cst name)), (genericParamsToExpr generics)])- wherePart = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ wherePart = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) in (Serialization.newlineSep (Lists.concat [ docPart,- (Optionals.cases derivesAttr [] (\d -> [+ (Optionals.match derivesAttr [] (\d -> [ d])), [ Serialization.spaceSep (Optionals.givens [@@ -1020,7 +1021,7 @@ rest = Syntax.structExprRest s fieldExprs = Lists.map fieldValueToExpr fields restExpr =- Optionals.cases rest [] (\r -> [+ Optionals.match rest [] (\r -> [ Serialization.spaceSep [ Serialization.cst "..", (expressionToExpr r)]])@@ -1038,7 +1039,7 @@ pub = Syntax.structFieldPublic field docC = Syntax.structFieldDoc field pubKw = Logic.ifElse pub (Just (Serialization.cst "pub")) Nothing- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) in (Serialization.newlineSep (Lists.concat [ docPart,@@ -1066,12 +1067,12 @@ -- | Convert a string to Rust line comments. Empty source lines emit `//` (no trailing space). toRustComment :: String -> String toRustComment c =- Strings.join "\n" (Lists.map (\s -> Logic.ifElse (Equality.equal s "") "//" (Strings.concat2 "// " s)) (Strings.lines c))+ Strings.join "\n" (Lists.map (\s -> Logic.ifElse (Equality.equal s "") "//" (Strings.concat2 "// " s)) (Formatting.lines c)) -- | Convert a string to Rust doc comments. Empty source lines emit `///` (no trailing space) so blank doc lines don't carry trailing whitespace. toRustDocComment :: String -> String toRustDocComment c =- Strings.join "\n" (Lists.map (\s -> Logic.ifElse (Equality.equal s "") "///" (Strings.concat2 "/// " s)) (Strings.lines c))+ Strings.join "\n" (Lists.map (\s -> Logic.ifElse (Equality.equal s "") "///" (Strings.concat2 "/// " s)) (Formatting.lines c)) -- | Serialize a trait associated constant traitConstToExpr :: Syntax.TraitConst -> Ast.Expr@@ -1081,7 +1082,7 @@ typ = Syntax.traitConstType c def = Syntax.traitConstDefault c defPart =- Optionals.cases def Nothing (\d -> Just (Serialization.spaceSep [+ Optionals.match def Nothing (\d -> Just (Serialization.spaceSep [ Serialization.cst "=", (expressionToExpr d)])) in (Serialization.spaceSep (Optionals.givens [@@ -1102,7 +1103,7 @@ items = Syntax.traitDefItems t isUnsafe = Syntax.traitDefUnsafe t docC = Syntax.traitDefDoc t- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) unsafeKw = Logic.ifElse isUnsafe (Just (Serialization.cst "unsafe")) Nothing genericsExpr = genericParamsToExpr generics@@ -1110,7 +1111,7 @@ Logic.ifElse (Lists.null supers) Nothing (Just (Serialization.spaceSep [ Serialization.cst ":", (Serialization.cst (Strings.join " + " (Lists.map (\b -> Serialization.printExpr (typeParamBoundToExpr b)) supers)))]))- wherePart = Optionals.cases whereC Nothing (\w -> Just (whereClauseToExpr w))+ wherePart = Optionals.match whereC Nothing (\w -> Just (whereClauseToExpr w)) header = Serialization.spaceSep (Optionals.givens [ unsafeKw,@@ -1147,7 +1148,7 @@ genericsExpr = genericParamsToExpr generics paramsExpr = Serialization.parenListAdaptive (Lists.map methodParamToExpr params) retTypeExpr =- Optionals.cases retType Nothing (\t -> Just (Serialization.spaceSep [+ Optionals.match retType Nothing (\t -> Just (Serialization.spaceSep [ Serialization.cst "->", (typeToExpr t)])) header =@@ -1157,7 +1158,7 @@ genericsExpr, (Just paramsExpr), retTypeExpr])- in (Optionals.cases defBody (Serialization.spaceSep [+ in (Optionals.match defBody (Serialization.spaceSep [ header, (Serialization.cst ";")]) (\body -> Serialization.spaceSep [ header,@@ -1175,7 +1176,7 @@ Serialization.cst ":", (Serialization.cst (Strings.join " + " (Lists.map (\b -> Serialization.printExpr (typeParamBoundToExpr b)) bounds)))])) defPart =- Optionals.cases def Nothing (\d -> Just (Serialization.spaceSep [+ Optionals.match def Nothing (\d -> Just (Serialization.spaceSep [ Serialization.cst "=", (typeToExpr d)])) in (Serialization.spaceSep (Optionals.givens [@@ -1214,7 +1215,7 @@ generics = Syntax.typeAliasGenerics ta typ = Syntax.typeAliasType ta docC = Syntax.typeAliasDoc ta- docPart = Optionals.cases docC [] (\d -> [+ docPart = Optionals.match docC [] (\d -> [ Serialization.cst (toRustDocComment d)]) in (Serialization.newlineSep (Lists.concat [ docPart,@@ -1384,7 +1385,7 @@ cond = Syntax.whileExprCondition w body = Syntax.whileExprBody w labelPart =- Optionals.cases label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":"))))+ Optionals.match label Nothing (\lbl -> Just (Serialization.cst (Strings.concat2 "'" (Strings.concat2 lbl ":")))) condExpr = case cond of Syntax.IfConditionBool v0 -> expressionToExpr v0
src/main/haskell/Hydra/Yaml/Coder.hs view
@@ -197,7 +197,7 @@ \maybeElementCoder -> \maybeTerm -> let strippedMaybeTerm = Strip.deannotateTerm maybeTerm in case strippedMaybeTerm of- Core.TermOptional v0 -> Optionals.cases v0 (Right (YamlModel.NodeScalar YamlModel.ScalarNull)) (\innerTerm -> Eithers.bind (Coders.coderEncode maybeElementCoder innerTerm) (\encodedInner -> Right encodedInner))+ Core.TermOptional v0 -> Optionals.match v0 (Right (YamlModel.NodeScalar YamlModel.ScalarNull)) (\innerTerm -> Eithers.bind (Coders.coderEncode maybeElementCoder innerTerm) (\encodedInner -> Right encodedInner)) _ -> Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [ "expected optional term, found: ", (PrintCore.term maybeTerm)])))
src/main/haskell/Hydra/Yaml/Serde.hs view
@@ -15,6 +15,7 @@ import qualified Hydra.Error.System as ErrorSystem import qualified Hydra.Errors as Errors import qualified Hydra.File as File+import qualified Hydra.Formatting as Formatting import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as JsonModel import qualified Hydra.Overlay.Haskell.Lib.Chars as Chars@@ -74,7 +75,7 @@ Strings.concat (Lists.map (\line -> Logic.ifElse (Strings.null line) "" (Strings.concat [ " ", line,- "\n"])) (Strings.lines s))+ "\n"])) (Formatting.lines s)) -- | Check if character codes represent a decimal number isDecimalString :: [Int] -> Bool