diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,200 @@ --- +## [0.17.2] - 2026-07-28 + +Point release on the 0.17.x line. Themes: promotion of the generator's routing and manifest +logic into Hydra (`hydra.build.*`), per-package API-doc publishing across Java/Scala/Python, +constraint-polymorphic arithmetic, and new effectful stream/file primitives. Includes the base64 +binary-literal rename `literals.binaryToString`/`stringToBinary` → `binaryToBase64`/`base64ToBinary`, +a step toward [#417](https://github.com/CategoricalData/hydra/issues/417) (which remains in progress). + +### Highlights + +- **Build system promoted into Hydra**: the three generator drivers now consume `hydra.build.routing` + ([#560](https://github.com/CategoricalData/hydra/issues/560)) and `hydra.build.manifest` + ([#607](https://github.com/CategoricalData/hydra/issues/607)), retiring the legacy static prefix + tables; the cold-seeder oil-and-water violation is fixed + ([#608](https://github.com/CategoricalData/hydra/issues/608)) and guarded + ([#617](https://github.com/CategoricalData/hydra/issues/617)). +- **Per-package API docs** for all doc-bearing hosts: JavaDoc restructured with cross-links and a fixed + tag→CI→Pages chain ([#616](https://github.com/CategoricalData/hydra/issues/616)), plus mirrored + Scaladoc ([#619](https://github.com/CategoricalData/hydra/issues/619)) and Python API docs + ([#620](https://github.com/CategoricalData/hydra/issues/620)). +- **Constraint-polymorphic arithmetic**: a `numeric` type class with enforcement and value-level dispatch + ([#566](https://github.com/CategoricalData/hydra/issues/566)), reflected on the target hosts + ([#618](https://github.com/CategoricalData/hydra/issues/618)). + +### New features + +- Standard-stream primitives: `stdin`/`stdout`/`stderr` ([#526](https://github.com/CategoricalData/hydra/issues/526)). +- Recursive flag for `hydra.lib.files.listDirectory` ([#527](https://github.com/CategoricalData/hydra/issues/527)). +- Hydra-specific regex syntax with per-target translation (`hydra.read.regex` / `hydra.show.regex`) + ([#567](https://github.com/CategoricalData/hydra/issues/567)). +- Constraint-polymorphic arithmetic: `numeric` type class + value-level dispatch + ([#566](https://github.com/CategoricalData/hydra/issues/566)). +- Aggregated Java + Scala Maven publishing into a single Central Portal deployment + ([#591](https://github.com/CategoricalData/hydra/issues/591)). + +### Improvements + +- Generator drivers consume `hydra.build.routing` ([#560](https://github.com/CategoricalData/hydra/issues/560)) + and `hydra.build.manifest` ([#607](https://github.com/CategoricalData/hydra/issues/607)). +- Fixed the cold-seeder oil-and-water violation ([#608](https://github.com/CategoricalData/hydra/issues/608)) + and extended `check-oil-and-water.py` to catch cold-seeder imports of unpublished `Hydra.Build.*` + ([#617](https://github.com/CategoricalData/hydra/issues/617)). +- Moved non-kernel packages to strict validation, clearing the #575 backlog + ([#580](https://github.com/CategoricalData/hydra/issues/580)). +- Decoupled `Hydra.Sources.Test.All` from `Hydra.Sources.All`'s re-export list + ([#601](https://github.com/CategoricalData/hydra/issues/601)). +- Renamed `hydra.json.schema` to resolve the module-vs-namespace-prefix conflict that broke + file-per-module hosts ([#532](https://github.com/CategoricalData/hydra/issues/532)). +- Coders route `hydra.lib.*` overlay imports by overlay-module existence, not name-matching + `hydra.lib.defaults` ([#568](https://github.com/CategoricalData/hydra/issues/568)). +- Per-package JavaDoc/Scaladoc/Python-doc publishing + ([#616](https://github.com/CategoricalData/hydra/issues/616), + [#619](https://github.com/CategoricalData/hydra/issues/619), + [#620](https://github.com/CategoricalData/hydra/issues/620)). +- Aligned Java-host Scala/TypeScript generation with Haskell on expression layout (line-wrapping, + declaration order) ([#612](https://github.com/CategoricalData/hydra/issues/612)). + +### Bug fixes + +- **TypeScript** — added the missing CI job (zero prior coverage) + ([#571](https://github.com/CategoricalData/hydra/issues/571)); fixed the + `verify-distribution.sh` smoke-test import so the gate actually gates + ([#578](https://github.com/CategoricalData/hydra/issues/578)); emit `hydra.parse.regex`'s + `regexSequence` before its alternation use (TS2448) + ([#604](https://github.com/CategoricalData/hydra/issues/604)). +- **Build and sync** — `sync.sh` Phase 3 digest-cache now sees cross-package deps on moved kernel + symbols, fixing stale downstream output ([#606](https://github.com/CategoricalData/hydra/issues/606)). +- **Numeric constraints** — `#566` polymorphism now reflected on the target hosts (targets were + monomorphizing `int32->int32->int32`) ([#618](https://github.com/CategoricalData/hydra/issues/618)). + +--- + +## [0.17.1] - 2026-07-18 + +Consolidation release on the 0.17.x line, built against published 0.17.0 hosts. Themes: +generated term-reference DSLs, a translingual package-validation framework, promotion of the +build system into Hydra (`hydra-build`), and broad TypeScript-host and cross-host hardening. + +### Highlights + +- **Generated term-reference DSLs** ([#467](https://github.com/CategoricalData/hydra/issues/467)): + kernel term modules now emit one typed, rename-safe reference per definition into every target + language; the Java and Python coder sources were pivoted onto them, retiring ~700 stringly-typed + inline references. +- **Package validation** ([#574](https://github.com/CategoricalData/hydra/issues/574), + [#575](https://github.com/CategoricalData/hydra/issues/575)): a translingual `hydra.validate.*` + framework with per-package `ValidationProfile`s (undeclared-dependency gate, naming/ordering/docs + checks). See the [Validation](https://github.com/CategoricalData/hydra/wiki/Validation) wiki page. +- **`hydra-build` package** ([#546](https://github.com/CategoricalData/hydra/issues/546)): + build-orchestration logic that lived only in host scripts is now translingual Hydra + (`hydra.build.*`), extracted into a dedicated package. + +### New features + +- Generated term-reference DSLs ([#467](https://github.com/CategoricalData/hydra/issues/467)); + follow-ups: `TypedName` refs to derived encode/decode/show + ([#555](https://github.com/CategoricalData/hydra/issues/555)), non-kernel packages + ([#556](https://github.com/CategoricalData/hydra/issues/556)). +- Translingual package-validation framework ([#574](https://github.com/CategoricalData/hydra/issues/574), + [#575](https://github.com/CategoricalData/hydra/issues/575)). +- DSL-authoring registration guards: fail-fast completeness checks for the Java/Python/Scala DSL sources + ([#554](https://github.com/CategoricalData/hydra/issues/554)). +- `hydra-build` package: `hydra.build.modules` + ([#529](https://github.com/CategoricalData/hydra/issues/529)), `hydra.build.reconcile` + ([#530](https://github.com/CategoricalData/hydra/issues/530)), extracted from the kernel + ([#546](https://github.com/CategoricalData/hydra/issues/546)). +- Effectful `hydra.lib.system` primitive library ([#498](https://github.com/CategoricalData/hydra/issues/498)). +- SHA-256 cryptographic hash primitive in `hydra.lib` ([#524](https://github.com/CategoricalData/hydra/issues/524)). +- `hydra-jvm` package: shared JVM serde helpers relocated out of `hydra.java.serde` + ([#505](https://github.com/CategoricalData/hydra/issues/505)). +- Internalized the Hydra-TinkerPop bindings (formerly HydraPop) + ([#442](https://github.com/CategoricalData/hydra/issues/442)). +- Compact unit-valued variants in the JSON encoding ([#520](https://github.com/CategoricalData/hydra/issues/520)). +- Structured generation-provenance record (digest v2) ([#413](https://github.com/CategoricalData/hydra/issues/413), + [#523](https://github.com/CategoricalData/hydra/issues/523)). +- Metadata sidecar + content/version-addressed freshness (`moduleFormatVersion`) + ([#415](https://github.com/CategoricalData/hydra/issues/415)). +- Worker + issue hierarchy: agent/worker framework, cross-worktree messaging, issue-proposal queue + (contributor process only) ([#557](https://github.com/CategoricalData/hydra/issues/557)). + +### Improvements + +- Type inference for annotations ([#229](https://github.com/CategoricalData/hydra/issues/229)). +- Fixed the signature / definition split in primitive definitions + ([#502](https://github.com/CategoricalData/hydra/issues/502)). +- DSL usability passes across the host-native Java/Python/Scala surfaces + ([#430](https://github.com/CategoricalData/hydra/issues/430), + [#553](https://github.com/CategoricalData/hydra/issues/553)). +- Audited the Scala and Lisp-family coders for the unconditional `hydra.lib.*` overlay-import rewrite + ([#569](https://github.com/CategoricalData/hydra/issues/569)). + +### Bug fixes + +- **TypeScript host** — V8 stack budget on ts→Java ([#390](https://github.com/CategoricalData/hydra/issues/390)); + effectful libs not generated / 484 tsc errors ([#503](https://github.com/CategoricalData/hydra/issues/503)); + 15 effect/file inference cases ([#504](https://github.com/CategoricalData/hydra/issues/504)); + ts→ts self-host regression ([#507](https://github.com/CategoricalData/hydra/issues/507)); npm packages + bundling a duplicate kernel ([#584](https://github.com/CategoricalData/hydra/issues/584)); broken npm + entry points ([#587](https://github.com/CategoricalData/hydra/issues/587)); + `hydra.test.build.modules.allTests` gen-universe gap ([#588](https://github.com/CategoricalData/hydra/issues/588)). +- **TypeScript coder** — reactivated `hydra.lib.*` tests: lazy show-calling let bindings + compact + `LiteralType` expansion ([#564](https://github.com/CategoricalData/hydra/issues/564)); `binaryToBytes` + registration + base64 decode in `decodeUtf8` ([#561](https://github.com/CategoricalData/hydra/issues/561)); + `hydra.test.build.*` emission after the #546 split + ([#570](https://github.com/CategoricalData/hydra/issues/570)); `HYDRA_DEFAULT_IMPLS` in the test runner + ([#536](https://github.com/CategoricalData/hydra/issues/536)); overlay-import rewrite no longer captures + `hydra.lib.defaults` ([#565](https://github.com/CategoricalData/hydra/issues/565)). +- **Lisp family** — clj→clj bootstrap hang in `generate_source_files` + ([#479](https://github.com/CategoricalData/hydra/issues/479)); Common Lisp `test_graph.lisp` loader + forward-reference ([#496](https://github.com/CategoricalData/hydra/issues/496)); Scheme maps + last-writer-wins in `union` ([#545](https://github.com/CategoricalData/hydra/issues/545)); Emacs Lisp + bootstrap `wrong-type-argument (listp :string)` ([#586](https://github.com/CategoricalData/hydra/issues/586)); + `hydra.build.*` regeneration into the Lisp dialects ([#544](https://github.com/CategoricalData/hydra/issues/544)). +- **Kernel and coders** — Java binary-literal signed-byte emission + ([#528](https://github.com/CategoricalData/hydra/issues/528)); `hydra.json.Decode.fromJson` + parametric-type support ([#531](https://github.com/CategoricalData/hydra/issues/531)); stale 2-param + `Coder` shape in Java/Scala test bootstrap ([#552](https://github.com/CategoricalData/hydra/issues/552)); + Java Javadoc ampersand escaping ([#493](https://github.com/CategoricalData/hydra/issues/493)); Scala + coder over-generalizing `Schema[S,T,V,E]` args, breaking `hydra-pg` + ([#589](https://github.com/CategoricalData/hydra/issues/589)); kernel dead-code/TODO cleanup + ([#538](https://github.com/CategoricalData/hydra/issues/538)). +- **Publishing and packaging** — self-broken 0.16.0 `hydra-kernel`/`hydra-python` wheels + ([#472](https://github.com/CategoricalData/hydra/issues/472)). +- **Lib and build** — `hydra.lib.files` copy/removeDirectory/status overlays across all nine hosts + ([#525](https://github.com/CategoricalData/hydra/issues/525)); standalone-kernel SHA dependency + ([#542](https://github.com/CategoricalData/hydra/issues/542)); lexicon's empty Types section + ([#539](https://github.com/CategoricalData/hydra/issues/539)); silent lexicon-generation failure since + the coders moved to in-memory synthesis ([#448](https://github.com/CategoricalData/hydra/issues/448)); + duplicated generated-file header in `generate-head-haskell-build.py` + ([#540](https://github.com/CategoricalData/hydra/issues/540)); `.gitignore` untracking 41 duplicate + overlaid-runtime copies under `dist/haskell/` ([#501](https://github.com/CategoricalData/hydra/issues/501)); + `bin/prepare-release.sh` Java quality check repointed to `dist/java/hydra-pg` tests after + ([#511](https://github.com/CategoricalData/hydra/issues/511)). +- **Tests and CI** — restored default-primitive-implementation testing + ([#388](https://github.com/CategoricalData/hydra/issues/388), + [#549](https://github.com/CategoricalData/hydra/issues/549)); reactivated ignored kernel test cases + ([#513](https://github.com/CategoricalData/hydra/issues/513), + [#550](https://github.com/CategoricalData/hydra/issues/550)); wired + split out the regression harnesses + ([#535](https://github.com/CategoricalData/hydra/issues/535), + [#563](https://github.com/CategoricalData/hydra/issues/563)); Scala/Go/Lisp self-containment gates + ([#537](https://github.com/CategoricalData/hydra/issues/537)); manifest-JSON-tracked CI check + ([#541](https://github.com/CategoricalData/hydra/issues/541)); per-package test-digest freshness + ([#551](https://github.com/CategoricalData/hydra/issues/551)); overlay-file restoration in + `test-stale-output-prune.sh` ([#558](https://github.com/CategoricalData/hydra/issues/558)); DSL-aware + sync-freshness fingerprint ([#562](https://github.com/CategoricalData/hydra/issues/562)). + +### Documentation + +- Corrected 0.17.0 Maven coordinates and added npm/Scala release channels, TypeScript/Scala/Lisp + Getting-started sections, and issue/PR templates + ([#519](https://github.com/CategoricalData/hydra/issues/519)). + +--- + ## [0.17.0] - 2026-07-01 Major themes: first-class support for effects and I/O in the kernel, TypeScript and diff --git a/hydra-kernel.cabal b/hydra-kernel.cabal --- a/hydra-kernel.cabal +++ b/hydra-kernel.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1. +-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: hydra-kernel -version: 0.17.0 +version: 0.17.3 synopsis: The Hydra kernel: core types, terms, inference, and DSL runtime 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". This package is the Hydra kernel: the core type and term model, type inference, the term rewriting and reduction engine, the primitive library, and the DSL runtime — the code that must be present in every Hydra implementation. The convenient entry point is the Hydra.Kernel module, which re-exports the kernel's collision-free surface. category: Data @@ -54,6 +54,7 @@ Hydra.Decode.Parsing Hydra.Decode.Paths Hydra.Decode.Query + Hydra.Decode.Regex Hydra.Decode.Relational Hydra.Decode.System Hydra.Decode.Tabular @@ -70,45 +71,81 @@ Hydra.Dependencies Hydra.Differentiation Hydra.Docs + Hydra.Dsl.Analysis + Hydra.Dsl.Annotations + Hydra.Dsl.Arity Hydra.Dsl.Ast + Hydra.Dsl.Checking Hydra.Dsl.Coders + Hydra.Dsl.Constants Hydra.Dsl.Core + Hydra.Dsl.Dependencies Hydra.Dsl.Docs + Hydra.Dsl.Environment Hydra.Dsl.Error.Checking Hydra.Dsl.Error.Core Hydra.Dsl.Error.File Hydra.Dsl.Error.Packaging Hydra.Dsl.Error.System Hydra.Dsl.Errors + Hydra.Dsl.Extract.Json Hydra.Dsl.File + Hydra.Dsl.Formatting Hydra.Dsl.Graph + Hydra.Dsl.Json.Bootstrap + Hydra.Dsl.Json.Decode + Hydra.Dsl.Json.Decoding + Hydra.Dsl.Json.Encode Hydra.Dsl.Json.Model + Hydra.Dsl.Json.Parser + Hydra.Dsl.Json.Writer + Hydra.Dsl.Json.Yaml.Decode + Hydra.Dsl.Json.Yaml.Encode + Hydra.Dsl.Lexical Hydra.Dsl.Lib.Chars + Hydra.Dsl.Lib.Defaults Hydra.Dsl.Lib.Eithers Hydra.Dsl.Lib.Equality + Hydra.Dsl.Lib.Functions Hydra.Dsl.Lib.Lists Hydra.Dsl.Lib.Literals Hydra.Dsl.Lib.Logic Hydra.Dsl.Lib.Maps Hydra.Dsl.Lib.Math Hydra.Dsl.Lib.Optionals + Hydra.Dsl.Lib.Ordering Hydra.Dsl.Lib.Pairs Hydra.Dsl.Lib.Regex Hydra.Dsl.Lib.Sets Hydra.Dsl.Lib.Strings + Hydra.Dsl.Names Hydra.Dsl.Packaging Hydra.Dsl.Parsing Hydra.Dsl.Paths + Hydra.Dsl.Predicates + Hydra.Dsl.Print.Docs Hydra.Dsl.Query + Hydra.Dsl.Reduction + Hydra.Dsl.Refs + Hydra.Dsl.Regex Hydra.Dsl.Relational + Hydra.Dsl.Resolution + Hydra.Dsl.Rewriting + Hydra.Dsl.Scoping + Hydra.Dsl.Serialization + Hydra.Dsl.Sorting + Hydra.Dsl.Strip Hydra.Dsl.System Hydra.Dsl.Tabular + Hydra.Dsl.Test.Transform + Hydra.Dsl.Test.Utils Hydra.Dsl.Testing Hydra.Dsl.Time Hydra.Dsl.Topology Hydra.Dsl.Typing Hydra.Dsl.Util Hydra.Dsl.Validation + Hydra.Dsl.Variables Hydra.Dsl.Variants Hydra.Dsl.Yaml.Model Hydra.Dsls @@ -128,6 +165,7 @@ Hydra.Encode.Parsing Hydra.Encode.Paths Hydra.Encode.Query + Hydra.Encode.Regex Hydra.Encode.Relational Hydra.Encode.System Hydra.Encode.Tabular @@ -169,16 +207,20 @@ Hydra.Languages Hydra.Lexical Hydra.Lib.Chars + Hydra.Lib.Defaults Hydra.Lib.Effects Hydra.Lib.Eithers Hydra.Lib.Equality Hydra.Lib.Files + Hydra.Lib.Functions + Hydra.Lib.Hashing Hydra.Lib.Lists Hydra.Lib.Literals Hydra.Lib.Logic Hydra.Lib.Maps Hydra.Lib.Math Hydra.Lib.Optionals + Hydra.Lib.Ordering Hydra.Lib.Pairs Hydra.Lib.Regex Hydra.Lib.Sets @@ -215,12 +257,15 @@ Hydra.Overlay.Haskell.Lib.Eithers Hydra.Overlay.Haskell.Lib.Equality Hydra.Overlay.Haskell.Lib.Files + Hydra.Overlay.Haskell.Lib.Functions + Hydra.Overlay.Haskell.Lib.Hashing Hydra.Overlay.Haskell.Lib.Lists Hydra.Overlay.Haskell.Lib.Literals Hydra.Overlay.Haskell.Lib.Logic Hydra.Overlay.Haskell.Lib.Maps Hydra.Overlay.Haskell.Lib.Math Hydra.Overlay.Haskell.Lib.Optionals + Hydra.Overlay.Haskell.Lib.Ordering Hydra.Overlay.Haskell.Lib.Pairs Hydra.Overlay.Haskell.Lib.Regex Hydra.Overlay.Haskell.Lib.Sets @@ -229,30 +274,37 @@ Hydra.Overlay.Haskell.Lib.Text Hydra.Overlay.Haskell.Libraries Hydra.Packaging + Hydra.Parse.Docs + Hydra.Parse.Regex Hydra.Parsers Hydra.Parsing Hydra.Paths Hydra.Predicates + Hydra.Print.Core + Hydra.Print.Docs + Hydra.Print.Emacs.Regex + Hydra.Print.Error.Core + Hydra.Print.Error.Packaging + Hydra.Print.Errors + Hydra.Print.Graph + Hydra.Print.Paths + Hydra.Print.Pcre.Regex + Hydra.Print.Posix.Regex + Hydra.Print.Regex + Hydra.Print.Typing + Hydra.Print.Util + Hydra.Print.Variants Hydra.Query - Hydra.Read.Docs Hydra.Reduction Hydra.Reflect + Hydra.Refs + Hydra.Regex Hydra.Relational Hydra.Resolution Hydra.Rewriting Hydra.Scoping Hydra.Serialization Hydra.Settings - Hydra.Show.Core - Hydra.Show.Docs - Hydra.Show.Error.Core - Hydra.Show.Error.Packaging - Hydra.Show.Errors - Hydra.Show.Graph - Hydra.Show.Paths - Hydra.Show.Typing - Hydra.Show.Util - Hydra.Show.Variants Hydra.Sorting Hydra.Strip Hydra.Substitution @@ -279,7 +331,8 @@ hs-source-dirs: src/main/haskell build-depends: - base >=4.19.0 && <4.22 + SHA >=1.6.4 && <1.7 + , base >=4.19.0 && <4.22 , base64-bytestring >=1.2.1 && <1.3 , bytestring >=0.11.5 && <0.13 , containers >=0.6.7 && <0.8 diff --git a/src/main/haskell/Hydra/Adapt.hs b/src/main/haskell/Hydra/Adapt.hs --- a/src/main/haskell/Hydra/Adapt.hs +++ b/src/main/haskell/Hydra/Adapt.hs @@ -25,6 +25,7 @@ import qualified Hydra.Lexical as Lexical import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Functions as Functions import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Literals as LibLiterals import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic @@ -38,16 +39,17 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Print.Graph as PrintGraph import qualified Hydra.Query as Query import qualified Hydra.Reduction as Reduction import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Resolution as Resolution import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors -import qualified Hydra.Show.Graph as ShowGraph import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -173,7 +175,7 @@ adaptLiteral lt l = case l of Core.LiteralBinary v0 -> case lt of - Core.LiteralTypeString -> Core.LiteralString (LibLiterals.binaryToString v0) + Core.LiteralTypeString -> Core.LiteralString (LibLiterals.binaryToBase64 v0) Core.LiteralBoolean v0 -> case lt of Core.LiteralTypeInteger v1 -> Core.LiteralInteger (Literals.bigintToIntegerValue v1 (Logic.ifElse v0 1 0)) Core.LiteralDecimal v0 -> case lt of @@ -209,12 +211,12 @@ adaptLiteralTypesMap constraints = let tryType = \lt -> Optionals.cases (adaptLiteralType constraints lt) Nothing (\lt2 -> Just (lt, lt2)) - in (Maps.fromList (Optionals.cat (Lists.map tryType Reflect.literalTypes))) + in (Maps.fromList (Optionals.givens (Lists.map tryType Reflect.literalTypes))) -- | Adapt a literal value using the given language constraints adaptLiteralValue :: Ord t0 => (M.Map t0 Core.LiteralType -> t0 -> Core.Literal -> Core.Literal) adaptLiteralValue litmap lt l = - Optionals.cases (Maps.lookup lt litmap) (Core.LiteralString (ShowCore.literal l)) (\lt2 -> adaptLiteral lt2 l) + Optionals.cases (Maps.lookup lt litmap) (Core.LiteralString (PrintCore.literal l)) (\lt2 -> adaptLiteral lt2 l) -- | Rewrite callback for adapting nested let binding TypeSchemes in a term adaptNestedTypes :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> (t0 -> Either Errors.Error Core.Term) -> t0 -> Either Errors.Error Core.Term @@ -276,7 +278,7 @@ Core.typeApplicationTermBody = (Core.typeApplicationTermBody v0), Core.typeApplicationTermType = atyp}))) Core.TermTypeLambda _ -> Right term1 - _ -> Eithers.bind (tryTerm term1) (\mterm -> Optionals.cases mterm (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no alternatives for term: " (ShowCore.term term1))))) (\term2 -> Right term2)))) + _ -> Eithers.bind (tryTerm term1) (\mterm -> Optionals.cases mterm (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "no alternatives for term: " (PrintCore.term term1))))) (\term2 -> Right term2)))) in (Rewriting.rewriteTermM rewrite term0) -- | Adapt a term using the constraints of a given language @@ -322,7 +324,7 @@ let supportedVariant = Sets.member (Reflect.typeVariant typ) (Coders.languageConstraintsTypeVariants constraints) in (Logic.ifElse supportedVariant (forSupported typ) (forUnsupported typ)) rewrite = - \recurse -> \typ -> Eithers.bind (recurse typ) (\type1 -> Optionals.cases (tryType type1) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no alternatives for type: " (ShowCore.type_ typ))))) (\type2 -> Right type2)) + \recurse -> \typ -> Eithers.bind (recurse typ) (\type1 -> Optionals.cases (tryType type1) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "no alternatives for type: " (PrintCore.type_ typ))))) (\type2 -> Right type2)) in (Rewriting.rewriteTypeM rewrite type0) -- | Adapt a type using the constraints of a given language @@ -387,7 +389,7 @@ qualifyUntyped = \b -> let nm = Core.unName (Core.bindingName b) - in (Optionals.cases (Names.moduleNameOf (Core.bindingName b)) (Strings.cat2 "(no module) " nm) (\ns -> Strings.cat [ + in (Optionals.cases (Names.moduleNameOf (Core.bindingName b)) (Strings.concat2 "(no module) " nm) (\ns -> Strings.concat [ Packaging.unModuleName ns, " :: ", nm])) @@ -395,7 +397,7 @@ \debugLabel -> \bindings -> let untypedBindings = Lists.map qualifyUntyped (Lists.filter (\b -> Logic.not (Optionals.isGiven (Core.bindingTypeScheme b))) bindings) - in (Logic.ifElse (Lists.null untypedBindings) (Right bindings) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat [ + in (Logic.ifElse (Lists.null untypedBindings) (Right bindings) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat [ "Found ", (LibLiterals.showInt32 (Lists.length untypedBindings)), " untyped binding(s) (", @@ -403,7 +405,7 @@ "); each must carry a type scheme at this stage. ", "This usually means stale dist/json field shapes after a kernel record rename ", "(regenerate the affected package's JSON). Offending bindings (module :: name): ", - (Strings.intercalate ", " untypedBindings)]))))) + (Strings.join ", " untypedBindings)]))))) normalizeBindings = \bindings -> Lists.map (\b -> Core.Binding { Core.bindingName = (Core.bindingName b), @@ -444,7 +446,7 @@ t3 = peelOne t2 in (Optionals.cases (extractAnn t) (Optionals.cases (extractAnn t1) (Optionals.cases (extractAnn t2) (extractAnn t3) (\a -> Just a)) (\a -> Just a)) (\a -> Just a)) originalAnnotations = - Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.cases (findAnn (Core.bindingTerm b)) Nothing (\ann -> Just (Core.bindingName b, ann))) originalBindings)) + Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.cases (findAnn (Core.bindingTerm b)) Nothing (\ann -> Just (Core.bindingName b, ann))) originalBindings)) reattachAnnotation = \b -> Optionals.cases (Maps.lookup (Core.bindingName b) originalAnnotations) b (\ann -> Core.Binding { Core.bindingName = (Core.bindingName b), @@ -467,13 +469,13 @@ Lists.filter (\el -> Optionals.cases (Names.moduleNameOf (Core.bindingName el)) False (\ns -> Sets.member ns namespacesSet)) bins5 elementsByNamespace = Lists.foldl (\acc -> \el -> Optionals.cases (Names.moduleNameOf (Core.bindingName el)) acc (\ns -> - let existing = Optionals.cases (Maps.lookup ns acc) [] Equality.identity + let existing = Optionals.cases (Maps.lookup ns acc) [] Functions.identity in (Maps.insert ns (Lists.concat2 existing [ el]) acc))) Maps.empty selectedElements defsGrouped = Lists.map (\ns -> - let elsForNs = Optionals.cases (Maps.lookup ns elementsByNamespace) [] Equality.identity - in (Optionals.cat (Lists.map toDef elsForNs))) namespaces + let elsForNs = Optionals.cases (Maps.lookup ns elementsByNamespace) [] Functions.identity + in (Optionals.givens (Lists.map toDef elsForNs))) namespaces g = Lexical.buildGraph bins5 Maps.empty (Graph.graphPrimitives adapted) in (Right ( Graph.Graph { @@ -563,7 +565,7 @@ Core.LiteralTypeString, ( (\v -> case v of - Core.LiteralBinary v1 -> Core.LiteralString (LibLiterals.binaryToString v1) + Core.LiteralBinary v1 -> Core.LiteralString (LibLiterals.binaryToBase64 v1) _ -> v), (Sets.fromList [ "replace binary strings with character strings"]))) diff --git a/src/main/haskell/Hydra/Analysis.hs b/src/main/haskell/Hydra/Analysis.hs --- a/src/main/haskell/Hydra/Analysis.hs +++ b/src/main/haskell/Hydra/Analysis.hs @@ -39,6 +39,7 @@ import qualified Hydra.Paths as Paths import qualified Hydra.Predicates as Predicates 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.Scoping as Scoping @@ -62,7 +63,7 @@ addNamesToModuleNames :: (Packaging.ModuleName -> t0) -> S.Set Core.Name -> Util.ModuleNames t0 -> Util.ModuleNames t0 addNamesToModuleNames encodeModuleName names ns0 = - let nss = Sets.fromList (Optionals.cat (Lists.map Names.moduleNameOf (Sets.toList names))) + let nss = Sets.fromList (Optionals.givens (Lists.map Names.moduleNameOf (Sets.toList names))) toPair = \ns -> (ns, (encodeModuleName ns)) in Util.ModuleNames { Util.moduleNamesFocus = (Util.moduleNamesFocus ns0), @@ -132,7 +133,7 @@ Packaging.DefinitionTerm v0 -> Dependencies.termDependencyNames True True True (Packaging.termDefinitionBody v0) Packaging.DefinitionPrimitive v0 -> Dependencies.typeDependencyNames True (Core.typeSchemeBody (Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature v0))) allNames = Sets.unions (Lists.map defNames defs) - in (Sets.fromList (Optionals.cat (Lists.map Names.moduleNameOf (Sets.toList allNames)))) + in (Sets.fromList (Optionals.givens (Lists.map Names.moduleNameOf (Sets.toList allNames)))) -- | Find dependency module names in all of a set of terms (Either version) dependencyModuleNames :: t0 -> Graph.Graph -> Bool -> Bool -> Bool -> Bool -> [Core.Binding] -> Either Errors.Error (S.Set Packaging.ModuleName) @@ -154,7 +155,7 @@ (Dependencies.termDependencyNames binds withPrims withNoms decodedTerm)]) (Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\_a -> _a) (DecodeCore.term graph term))) (Right (Sets.unions [ dataNames, schemaNames])))) - in (Eithers.map (\namesList -> Sets.fromList (Optionals.cat (Lists.map Names.moduleNameOf (Sets.toList (Sets.unions namesList))))) (Eithers.mapList depNames els)) + in (Eithers.map (\namesList -> Sets.fromList (Optionals.givens (Lists.map Names.moduleNameOf (Sets.toList (Sets.unions namesList))))) (Eithers.mapList depNames els)) -- | Gather applications from a term, returning (args, baseTerm) gatherApplications :: Core.Term -> ([Core.Term], Core.Term) @@ -273,7 +274,7 @@ _ -> False) termContainsBinary = \term -> Rewriting.foldOverTerm Coders.TraversalOrderPre checkTerm False term defTerms = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Packaging.termDefinitionBody v0) _ -> Nothing) (Packaging.moduleDefinitions mod)) in (Lists.foldl (\acc -> \t -> Logic.or acc (termContainsBinary t)) False defTerms) @@ -290,7 +291,7 @@ _ -> False) termContainsDecimal = \term -> Rewriting.foldOverTerm Coders.TraversalOrderPre checkTerm False term defTerms = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Packaging.termDefinitionBody v0) _ -> Nothing) (Packaging.moduleDefinitions mod)) in (Lists.foldl (\acc -> \t -> Logic.or acc (termContainsDecimal t)) False defTerms) @@ -300,7 +301,7 @@ moduleDependencyModuleNames cx graph binds withPrims withNoms withSchema mod = let allBindings = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = diff --git a/src/main/haskell/Hydra/Annotations.hs b/src/main/haskell/Hydra/Annotations.hs --- a/src/main/haskell/Hydra/Annotations.hs +++ b/src/main/haskell/Hydra/Annotations.hs @@ -33,10 +33,11 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -88,7 +89,7 @@ v = Pairs.second p in (Optionals.map (\n -> (n, v)) (extractName k)) in case t of - Core.TermMap v0 -> Maps.fromList (Optionals.cat (Lists.map fromEntry (Maps.toList v0))) + Core.TermMap v0 -> Maps.fromList (Optionals.givens (Lists.map fromEntry (Maps.toList v0))) _ -> Maps.empty -- | Get description from annotations map (Either version) @@ -144,7 +145,7 @@ isNativeType el = let isFlaggedAsFirstClassType = - Optionals.fromOptional False (Optionals.map (\_ -> True) (getTermAnnotation Constants.keyFirstClassType (Core.bindingTerm el))) + Optionals.withDefault False (Optionals.map (\_ -> True) (getTermAnnotation Constants.keyFirstClassType (Core.bindingTerm el))) in (Optionals.cases (Core.bindingTypeScheme el) False (\ts -> Logic.and (Equality.equal ts (Core.TypeScheme { Core.typeSchemeVariables = [], Core.typeSchemeBody = (Core.TypeVariable (Core.Name "hydra.core.Type")), diff --git a/src/main/haskell/Hydra/Arity.hs b/src/main/haskell/Hydra/Arity.hs --- a/src/main/haskell/Hydra/Arity.hs +++ b/src/main/haskell/Hydra/Arity.hs @@ -23,6 +23,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Checking.hs b/src/main/haskell/Hydra/Checking.hs --- a/src/main/haskell/Hydra/Checking.hs +++ b/src/main/haskell/Hydra/Checking.hs @@ -36,15 +36,16 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Print.Variants as PrintVariants import qualified Hydra.Query as Query import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Resolution as Resolution import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors -import qualified Hydra.Show.Variants as ShowVariants import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System @@ -71,7 +72,7 @@ t = Pairs.second uc in (Lists.foldl (\b -> \x -> Logic.and b (Equality.equal x h)) True t)) --- | Apply type arguments to a type, substituting forall-bound variables +-- | Apply type arguments to a type, substituting forall-bound variables. Paper: inference.tex, 'Checking the witness' (consuming the pending-type-argument stack). applyTypeArgumentsToType :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Type -> Either Errors.Error Core.Type applyTypeArgumentsToType cx tx typeArgs t = Optionals.cases (Lists.uncons typeArgs) (Right t) (\uc -> @@ -84,12 +85,12 @@ in (applyTypeArgumentsToType cx tx at (Substitution.substInType (Typing.TypeSubst (Maps.singleton v ah)) tbody)) Core.TypeVariable v0 -> Eithers.either (\_ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "forall type", - Errors.unexpectedShapeErrorActual = (Strings.cat [ - ShowCore.type_ t, + Errors.unexpectedShapeErrorActual = (Strings.concat [ + PrintCore.type_ t, ". Trying to apply ", (Literals.showInt32 (Lists.length typeArgs)), " type args: ", - (Formatting.showList ShowCore.type_ typeArgs)])})))) (\schemaRes -> + (Formatting.showList PrintCore.type_ typeArgs)])})))) (\schemaRes -> let schemaType = Pairs.first schemaRes schemaBody = Strip.deannotateType (Core.typeSchemeBody schemaType) in case schemaBody of @@ -97,17 +98,17 @@ _ -> Right t) (Resolution.requireSchemaType cx (Graph.graphSchemaTypes tx) v0) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "forall type", - Errors.unexpectedShapeErrorActual = (Strings.cat [ - ShowCore.type_ t, + Errors.unexpectedShapeErrorActual = (Strings.concat [ + PrintCore.type_ t, ". Trying to apply ", (Literals.showInt32 (Lists.length typeArgs)), " type args: ", - (Formatting.showList ShowCore.type_ typeArgs), + (Formatting.showList PrintCore.type_ typeArgs), ". Context has vars: {", - (Strings.intercalate ", " (Lists.map Core.unName (Maps.keys (Graph.graphBoundTypes tx)))), + (Strings.join ", " (Lists.map Core.unName (Maps.keys (Graph.graphBoundTypes tx)))), "}"])})))) --- | Check that a term has no unbound type variables (Either version) +-- | Check that a term has no unbound type variables (Either version). Paper: inference.tex, 'Checking the witness' (always-on finalization invariant). checkForUnboundTypeVariables :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error () checkForUnboundTypeVariables cx tx term0 = @@ -141,21 +142,6 @@ in (checkRecursive Sets.empty [ "top level"] Nothing term0) --- | Check that a nominal type is applied to the correct number of type arguments (Either version) -checkNominalApplication :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> [Core.Type] -> Either Errors.Error ((), Typing.InferenceContext) -checkNominalApplication cx tx tname typeArgs = - Eithers.bind (Resolution.requireSchemaType cx (Graph.graphSchemaTypes tx) tname) (\result -> - let schemaType = Pairs.first result - cx2 = Pairs.second result - vars = Core.typeSchemeVariables schemaType - varslen = Lists.length vars - argslen = Lists.length typeArgs - in (Logic.ifElse (Equality.equal varslen argslen) (Right ((), cx2)) (Left (Errors.ErrorChecking (Checking.CheckingErrorTypeArityMismatch (Checking.TypeArityMismatchError { - Checking.typeArityMismatchErrorType = (Core.TypeVariable tname), - Checking.typeArityMismatchErrorExpectedArity = varslen, - Checking.typeArityMismatchErrorActualArity = argslen, - Checking.typeArityMismatchErrorTypeArguments = typeArgs})))))) - -- | Ensure all types in a list are equal and return the common type checkSameType :: t0 -> Graph.Graph -> String -> [Core.Type] -> Either Errors.Error Core.Type checkSameType cx tx desc types = @@ -164,18 +150,9 @@ Left (Errors.ErrorChecking (Checking.CheckingErrorUnequalTypes (Checking.UnequalTypesError { Checking.unequalTypesErrorTypes = types, Checking.unequalTypesErrorDescription = desc}))) - in (Logic.ifElse (typesAllEffectivelyEqual tx types) (Optionals.cases (Lists.maybeHead types) unequalErr (\t -> Right t)) unequalErr) - --- | Check that a term has the expected type -checkType :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> Core.Type -> Either Errors.Error () -checkType cx tx term typ = - - let vars = Graph.graphTypeVariables tx - in (Logic.ifElse Constants.debugInference (Eithers.bind (Eithers.map (\_p -> Pairs.first _p) (typeOf cx tx [] term)) (\t0 -> Logic.ifElse (typesEffectivelyEqual tx t0 typ) (Right ()) (Left (Errors.ErrorChecking (Checking.CheckingErrorTypeMismatch (Checking.TypeMismatchError { - Checking.typeMismatchErrorExpectedType = typ, - Checking.typeMismatchErrorActualType = t0})))))) (Right ())) + in (Logic.ifElse (typesAllEffectivelyEqual tx types) (Optionals.cases (Lists.head types) unequalErr (\t -> Right t)) unequalErr) --- | Sanity-check a type substitution arising from unification. Specifically, check that schema types have not been inappropriately unified with type variables inferred from terms. +-- | Sanity-check a type substitution arising from unification. Specifically, check that schema types have not been inappropriately unified with type variables inferred from terms. Paper: inference.tex, 'Checking the witness' (always-on invariant: a substitution may not bind a type name as if it were an inference variable). checkTypeSubst :: t0 -> Graph.Graph -> Typing.TypeSubst -> Either Errors.Error Typing.TypeSubst checkTypeSubst cx tx subst = @@ -191,14 +168,11 @@ badVars = Sets.fromList (Lists.filter (\v -> Optionals.cases (Lexical.dereferenceSchemaType v (Graph.graphSchemaTypes tx)) False isNominal) (Sets.toList suspectVars)) badPairs = Lists.filter (\p -> Sets.member (Pairs.first p) badVars) (Maps.toList s) - printPair = \p -> Strings.cat2 (Strings.cat2 (Core.unName (Pairs.first p)) " --> ") (ShowCore.type_ (Pairs.second p)) + printPair = + \p -> Strings.concat2 (Strings.concat2 (Core.unName (Pairs.first p)) " --> ") (PrintCore.type_ (Pairs.second p)) in (Logic.ifElse (Sets.null badVars) (Right subst) (Left (Errors.ErrorChecking (Checking.CheckingErrorIncorrectUnification (Checking.IncorrectUnificationError { Checking.incorrectUnificationErrorSubstitution = subst}))))) --- | Check that all type variables in a type are bound. NOTE: This check is currently disabled to allow phantom type variables from polymorphic instantiation to pass through. The proper fix is to ensure `typeOf` doesn't create fresh variables for post-inference code. -checkTypeVariables :: t0 -> t1 -> () -checkTypeVariables _tx _typ = () - -- | Check if a type contains any type variable from the current scope containsInScopeTypeVars :: Graph.Graph -> Core.Type -> Bool containsInScopeTypeVars tx t = @@ -207,13 +181,13 @@ freeVars = Variables.freeVariablesInTypeSimple t in (Logic.not (Sets.null (Sets.intersection vars freeVars))) --- | Normalize free type variables in a type to canonical names based on order of first occurrence. This allows comparing types that differ only in the naming of free type variables. +-- | Normalize free type variables in a type to canonical names based on order of first occurrence. This allows comparing types that differ only in the naming of free type variables. Paper: inference.tex, 'Checking the witness' (effective equality). normalizeTypeFreeVars :: Core.Type -> Core.Type normalizeTypeFreeVars typ = let collectVars = \acc -> \t -> case t of - Core.TypeVariable v0 -> Logic.ifElse (Maps.member v0 acc) acc (Maps.insert v0 (Core.Name (Strings.cat2 "_tv" (Literals.showInt32 (Maps.size acc)))) acc) + Core.TypeVariable v0 -> Logic.ifElse (Maps.member v0 acc) acc (Maps.insert v0 (Core.Name (Strings.concat2 "_tv" (Literals.showInt32 (Maps.size acc)))) acc) _ -> acc subst = Rewriting.foldOverType Coders.TraversalOrderPre collectVars Maps.empty typ in (Variables.substituteTypeVariables subst typ) @@ -227,7 +201,7 @@ typeListsEffectivelyEqual tx tlist1 tlist2 = Logic.ifElse (Equality.equal (Lists.length tlist1) (Lists.length tlist2)) (Lists.foldl Logic.and True (Lists.zipWith (typesEffectivelyEqual tx) tlist1 tlist2)) False --- | Given a type context, reconstruct the type of a System F term +-- | Given a type context, reconstruct the type of a System F term. Paper: inference.tex, 'Checking the witness' -- the executable form of the System F typing judgment in the soundness theorem. typeOf :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOf cx tx typeArgs term = @@ -257,11 +231,11 @@ _ -> Left (Errors.ErrorChecking (Checking.CheckingErrorUnsupportedTermVariant (Checking.UnsupportedTermVariantError { Checking.unsupportedTermVariantErrorTermVariant = (Reflect.termVariant term)}))) --- | Reconstruct the type of an annotated term (Either/InferenceContext version) +-- | Reconstruct the type of an annotated term (Either/InferenceContext version). Paper: inference.tex, rule Ann (checking side). typeOfAnnotatedTerm :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.AnnotatedTerm -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfAnnotatedTerm cx tx typeArgs at = typeOf cx tx typeArgs (Core.annotatedTermBody at) --- | Reconstruct the type of an application term (Either/InferenceContext version) +-- | Reconstruct the type of an application term (Either/InferenceContext version). Paper: inference.tex, rule App (checking side). typeOfApplication :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Application -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfApplication cx tx typeArgs app = @@ -294,7 +268,7 @@ cx4 = Pairs.second result3 in (Eithers.bind (applyTypeArgumentsToType cx4 tx typeArgs t) (\applied -> Right (applied, cx4))))))))) --- | Reconstruct the type of a case statement (Either/InferenceContext version) +-- | Reconstruct the type of a case statement (Either/InferenceContext version). Paper: inference.tex, rules Case and Case_d (checking side). typeOfCaseStatement :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.CaseStatement -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfCaseStatement cx tx typeArgs cs = @@ -322,14 +296,14 @@ in (Eithers.bind (ExtractCore.functionType t) (\ft -> Right (Lists.concat2 cods (Lists.pure (Core.functionTypeCodomain ft)), cx3))))) (Right ([], cx3)) tcterms in (Eithers.bind fcodsResult (\fcodsR -> let fcods = Pairs.first fcodsR - cods = Optionals.cat (Lists.cons tdflt (Lists.map Optionals.pure fcods)) + cods = Optionals.givens (Lists.cons tdflt (Lists.map Optionals.pure fcods)) in (Eithers.bind (checkSameType cx3 tx "case branches" cods) (\cod -> Right ( Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Resolution.nominalApplication tname typeArgs), Core.functionTypeCodomain = cod}), cx3))))))))) --- | Reconstruct the type of an either value (Either/InferenceContext version) +-- | Reconstruct the type of an either value (Either/InferenceContext version). Paper: inference.tex, rules Eith_L and Eith_R (checking side). typeOfEither :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Either Core.Term Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfEither cx tx typeArgs et = @@ -362,7 +336,7 @@ Core.eitherTypeRight = rightType}), cx2)))) et) arityErr))))) --- | Reconstruct the type of a union injection (Either/InferenceContext version) +-- | Reconstruct the type of a union injection (Either/InferenceContext version). Paper: inference.tex, rule Inj (checking side). typeOfInjection :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Injection -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfInjection cx tx typeArgs injection = @@ -377,7 +351,7 @@ sbody = Core.typeSchemeBody schemaType in (Eithers.bind (ExtractCore.unionType tname sbody) (\sfields -> Eithers.bind (Resolution.findFieldType cx2 fname sfields) (\ftyp -> Right (Resolution.nominalApplication tname typeArgs, cx2)))))) --- | Reconstruct the type of a lambda function (Either/InferenceContext version) +-- | Reconstruct the type of a lambda function (Either/InferenceContext version). Paper: inference.tex, rule Abs (checking side). typeOfLambda :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Lambda -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfLambda cx tx typeArgs l = @@ -407,7 +381,7 @@ cx3 = Pairs.second tbodyResult in (Eithers.bind (applyTypeArgumentsToType cx3 tx typeArgs tbody) (\applied -> Right (applied, cx3))))) --- | Reconstruct the type of a let binding (Either/InferenceContext version) +-- | Reconstruct the type of a let binding (Either/InferenceContext version). Paper: inference.tex, rule Let (checking side). typeOfLet :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Let -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfLet cx tx typeArgs letTerm = @@ -438,7 +412,7 @@ cx2 = Pairs.second tResult in (Eithers.bind (applyTypeArgumentsToType cx2 tx typeArgs t) (\applied -> Right (applied, cx2))))))) --- | Reconstruct the type of a list (Either/InferenceContext version) +-- | Reconstruct the type of a list (Either/InferenceContext version). Paper: inference.tex, rules Lst_0 and Lst_+ (checking side). typeOfList :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> [Core.Term] -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfList cx tx typeArgs els = @@ -448,7 +422,7 @@ Checking.typeArityMismatchErrorExpectedArity = 1, Checking.typeArityMismatchErrorActualArity = (Lists.length typeArgs), Checking.typeArityMismatchErrorTypeArguments = typeArgs}))) - in (Logic.ifElse (Lists.null els) (Logic.ifElse (Equality.equal (Lists.length typeArgs) 1) (Optionals.cases (Lists.maybeHead typeArgs) listArityErr (\ta0 -> Right (Core.TypeList ta0, cx))) listArityErr) ( + in (Logic.ifElse (Lists.null els) (Logic.ifElse (Equality.equal (Lists.length typeArgs) 1) (Optionals.cases (Lists.head typeArgs) listArityErr (\ta0 -> Right (Core.TypeList ta0, cx))) listArityErr) ( let foldResult = Lists.foldl (\acc -> \term -> Eithers.bind acc (\accR -> let types = Pairs.first accR @@ -462,14 +436,14 @@ cx2 = Pairs.second foldR in (Eithers.bind (checkSameType cx2 tx "list elements" eltypes) (\unifiedType -> Right (Core.TypeList unifiedType, cx2))))))) --- | Reconstruct the type of a literal (Either/InferenceContext version) +-- | Reconstruct the type of a literal (Either/InferenceContext version). Paper: inference.tex, rule Lit (checking side). typeOfLiteral :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Literal -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfLiteral cx tx typeArgs lit = let t = Core.TypeLiteral (Reflect.literalType lit) in (Eithers.bind (applyTypeArgumentsToType cx tx typeArgs t) (\applied -> Right (applied, cx))) --- | Reconstruct the type of a map (Either/InferenceContext version) +-- | Reconstruct the type of a map (Either/InferenceContext version). Paper: inference.tex, rules Map_0 and Map_+ (checking side). typeOfMap :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> M.Map Core.Term Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfMap cx tx typeArgs m = @@ -518,7 +492,7 @@ Core.mapTypeKeys = kt, Core.mapTypeValues = vt}))) (\applied -> Right (applied, cx3)))))))))))) --- | Reconstruct the type of an optional value (Either/InferenceContext version) +-- | Reconstruct the type of an optional value (Either/InferenceContext version). Paper: inference.tex, rules Opt_0 and Opt_1 (checking side). typeOfMaybe :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Maybe Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfMaybe cx tx typeArgs mt = @@ -531,7 +505,7 @@ Checking.typeArityMismatchErrorExpectedArity = 1, Checking.typeArityMismatchErrorActualArity = n, Checking.typeArityMismatchErrorTypeArguments = typeArgs}))) - in (Logic.ifElse (Equality.equal n 1) (Optionals.cases (Lists.maybeHead typeArgs) maybeArityErr (\ta0 -> Right (Core.TypeOptional ta0, cx))) maybeArityErr) + in (Logic.ifElse (Equality.equal n 1) (Optionals.cases (Lists.head typeArgs) maybeArityErr (\ta0 -> Right (Core.TypeOptional ta0, cx))) maybeArityErr) forJust = \term -> Eithers.bind (typeOf cx tx [] term) (\tResult -> let termType = Pairs.first tResult @@ -540,7 +514,7 @@ in (Eithers.bind (applyTypeArgumentsToType cx2 tx typeArgs t) (\applied -> Right (applied, cx2)))) in (Optionals.cases mt forNothing forJust) --- | Reconstruct the type of a pair (Either/InferenceContext version) +-- | Reconstruct the type of a pair (Either/InferenceContext version). Paper: inference.tex, rule Pair (checking side). typeOfPair :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> (Core.Term, Core.Term) -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfPair cx tx typeArgs p = @@ -566,7 +540,7 @@ Checking.typeArityMismatchErrorActualArity = n, Checking.typeArityMismatchErrorTypeArguments = typeArgs}))))) --- | Reconstruct the type of a primitive function (Either/InferenceContext version) +-- | Reconstruct the type of a primitive function (Either/InferenceContext version). Paper: inference.tex, rule Prim (checking side). typeOfPrimitive :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfPrimitive cx tx typeArgs name = @@ -581,7 +555,7 @@ t = Scoping.typeSchemeToFType ts in (Eithers.bind (applyTypeArgumentsToType cx2 tx typeArgs t) (\applied -> Right (applied, cx2))))) --- | Reconstruct the type of a record projection (Either/InferenceContext version) +-- | Reconstruct the type of a record projection (Either/InferenceContext version). Paper: inference.tex, rule Proj (checking side). typeOfProjection :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Projection -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfProjection cx tx typeArgs p = @@ -601,7 +575,7 @@ Core.functionTypeCodomain = sftyp}), cx2))))))) --- | Reconstruct the type of a record (Either/InferenceContext version) +-- | Reconstruct the type of a record (Either/InferenceContext version). Paper: inference.tex, rule Rec (checking side). typeOfRecord :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Record -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfRecord cx tx typeArgs record = @@ -619,7 +593,7 @@ let cx2 = Pairs.second foldR in (Right (Resolution.nominalApplication tname typeArgs, cx2)))) --- | Reconstruct the type of a set (Either/InferenceContext version) +-- | Reconstruct the type of a set (Either/InferenceContext version). Paper: inference.tex, rules Set_0 and Set_+ (checking side). typeOfSet :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> S.Set Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfSet cx tx typeArgs els = @@ -629,7 +603,7 @@ Checking.typeArityMismatchErrorExpectedArity = 1, Checking.typeArityMismatchErrorActualArity = (Lists.length typeArgs), Checking.typeArityMismatchErrorTypeArguments = typeArgs}))) - in (Logic.ifElse (Sets.null els) (Logic.ifElse (Equality.equal (Lists.length typeArgs) 1) (Optionals.cases (Lists.maybeHead typeArgs) setArityErr (\ta0 -> Right (Core.TypeSet ta0, cx))) setArityErr) ( + in (Logic.ifElse (Sets.null els) (Logic.ifElse (Equality.equal (Lists.length typeArgs) 1) (Optionals.cases (Lists.head typeArgs) setArityErr (\ta0 -> Right (Core.TypeSet ta0, cx))) setArityErr) ( let foldResult = Lists.foldl (\acc -> \term -> Eithers.bind acc (\accR -> let types = Pairs.first accR @@ -647,7 +621,7 @@ typeOfTerm :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Type typeOfTerm cx g term = Eithers.map Pairs.first (typeOf cx g [] term) --- | Reconstruct the type of a type application term (Either/InferenceContext version) +-- | Reconstruct the type of a type application term (Either/InferenceContext version). Paper: inference.tex, 'Checking the witness' (pushes onto the pending-type-argument stack). typeOfTypeApplication :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.TypeApplicationTerm -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfTypeApplication cx tx typeArgs tyapp = @@ -655,7 +629,7 @@ t = Core.typeApplicationTermType tyapp in (typeOf cx tx (Lists.cons t typeArgs) body) --- | Reconstruct the type of a type lambda (type abstraction) term (Either/InferenceContext version) +-- | Reconstruct the type of a type lambda (type abstraction) term (Either/InferenceContext version). Paper: inference.tex, type abstraction terms in the elaborated Term grammar. typeOfTypeLambda :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.TypeLambda -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfTypeLambda cx tx typeArgs tl = @@ -679,12 +653,12 @@ Core.forallTypeParameter = v, Core.forallTypeBody = t1}))) (\applied -> Right (applied, cx2))))) --- | Reconstruct the type of the unit term (Either/InferenceContext version) +-- | Reconstruct the type of the unit term (Either/InferenceContext version). Paper: inference.tex, rule Unit (checking side). typeOfUnit :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfUnit cx tx typeArgs = Eithers.bind (applyTypeArgumentsToType cx tx typeArgs Core.TypeUnit) (\applied -> Right (applied, cx)) --- | Reconstruct the type of an unwrap operation (Either/InferenceContext version) +-- | Reconstruct the type of an unwrap operation (Either/InferenceContext version). Paper: inference.tex, rule Unwr (checking side). typeOfUnwrap :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfUnwrap cx tx typeArgs tname = Eithers.bind (Resolution.requireSchemaType cx (Graph.graphSchemaTypes tx) tname) (\schemaResult -> @@ -701,7 +675,7 @@ Core.functionTypeCodomain = swrapped}), cx2))))) --- | Reconstruct the type of a variable (Either/InferenceContext version) +-- | Reconstruct the type of a variable (Either/InferenceContext version). Paper: inference.tex, rules Var and Prim (checking side); note the primitives-first lookup order, the reverse of inference. typeOfVariable :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfVariable cx tx typeArgs name = @@ -718,7 +692,7 @@ ErrorCore.untypedTermVariableErrorLocation = (Paths.SubtermPath []), ErrorCore.untypedTermVariableErrorName = name}))) forScheme) forScheme) --- | Reconstruct the type of a wrapped term (Either/InferenceContext version) +-- | Reconstruct the type of a wrapped term (Either/InferenceContext version). Paper: inference.tex, rule Wrp (checking side). typeOfWrappedTerm :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.WrappedTerm -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfWrappedTerm cx tx typeArgs wt = @@ -741,7 +715,7 @@ anyContainsFreeVar = Lists.foldl (\acc -> \t -> Logic.or acc (containsFreeVar t)) False tlist in (Logic.ifElse anyContainsFreeVar True (Logic.ifElse (allEqual (Lists.map (\t -> normalizeTypeFreeVars t) tlist)) True (allEqual (Lists.map (\t -> normalizeTypeFreeVars (Strip.deannotateTypeRecursive (Dependencies.replaceTypedefs types t))) tlist)))) --- | Check whether two types are effectively equal, disregarding type aliases, forall quantifiers, and treating in-scope type variables as wildcards +-- | Check whether two types are effectively equal, disregarding type aliases, forall quantifiers, and treating in-scope type variables as wildcards. Paper: inference.tex, 'Checking the witness' (effective equality, the type-level analogue of the referential-transparency equality of terms). typesEffectivelyEqual :: Graph.Graph -> Core.Type -> Core.Type -> Bool typesEffectivelyEqual tx t1 t2 = Logic.or (containsInScopeTypeVars tx t1) (Logic.or (containsInScopeTypeVars tx t2) (typesAllEffectivelyEqual tx [ diff --git a/src/main/haskell/Hydra/Classes.hs b/src/main/haskell/Hydra/Classes.hs --- a/src/main/haskell/Hydra/Classes.hs +++ b/src/main/haskell/Hydra/Classes.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -39,6 +40,12 @@ equality :: Typing.TypeClass equality = Typing.TypeClass { Typing.typeClassDescription = "Equality: instances support structural equality."} + +-- | The numeric type class: instances support arithmetic (addition, subtraction, multiplication, negation). +numeric :: Typing.TypeClass +numeric = + Typing.TypeClass { + Typing.typeClassDescription = "Numeric: instances support arithmetic (addition, subtraction, multiplication, negation)."} -- | The ordering type class: instances support total ordering (and equality). ordering :: Typing.TypeClass diff --git a/src/main/haskell/Hydra/Codegen.hs b/src/main/haskell/Hydra/Codegen.hs --- a/src/main/haskell/Hydra/Codegen.hs +++ b/src/main/haskell/Hydra/Codegen.hs @@ -39,6 +39,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -46,11 +47,12 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -84,20 +86,20 @@ escapeControlCharsInJson :: [Int] -> [Int] escapeControlCharsInJson input = - let hexDigit = \n -> Logic.ifElse (Equality.lt n 10) (Math.add 48 n) (Math.add 97 (Math.sub n 10)) + let hexDigit = \n -> Logic.ifElse (Ordering.lt n 10) (Math.add 48 n) (Math.add 97 (Math.sub n 10)) escapeToUnicode = \b -> [ 92, 117, 48, 48, - (hexDigit (Optionals.fromOptional 0 (Math.maybeDiv b 16))), - (hexDigit (Optionals.fromOptional 0 (Math.maybeMod b 16)))] + (hexDigit (Optionals.withDefault 0 (Math.div b 16))), + (hexDigit (Optionals.withDefault 0 (Math.mod b 16)))] go = \inStr -> \esc -> \bytes -> Optionals.cases (Lists.uncons bytes) [] (\uc -> let b = Pairs.first uc bs = Pairs.second uc - in (Logic.ifElse esc (Lists.cons b (go inStr False bs)) (Logic.ifElse (Logic.and (Equality.equal b 92) inStr) (Lists.cons b (go inStr True bs)) (Logic.ifElse (Equality.equal b 34) (Lists.cons b (go (Logic.not inStr) False bs)) (Logic.ifElse (Logic.and inStr (Equality.lt b 32)) (Lists.concat2 (escapeToUnicode b) (go inStr False bs)) (Lists.cons b (go inStr False bs))))))) + in (Logic.ifElse esc (Lists.cons b (go inStr False bs)) (Logic.ifElse (Logic.and (Equality.equal b 92) inStr) (Lists.cons b (go inStr True bs)) (Logic.ifElse (Equality.equal b 34) (Lists.cons b (go (Logic.not inStr) False bs)) (Logic.ifElse (Logic.and inStr (Ordering.lt b 32)) (Lists.concat2 (escapeToUnicode b) (go inStr False bs)) (Lists.cons b (go inStr False bs))))))) in (go False False input) -- | Format a primitive for the lexicon @@ -106,21 +108,21 @@ let name = Core.unName (Packaging.primitiveDefinitionName (Graph.primitiveDefinition prim)) typ = Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition prim)) - typeStr = ShowCore.typeScheme typ - in (Strings.cat2 (Strings.cat2 (Strings.cat2 " " name) " : ") typeStr) + typeStr = PrintCore.typeScheme typ + in (Strings.concat2 (Strings.concat2 (Strings.concat2 " " name) " : ") typeStr) -- | Format a term binding for the lexicon formatTermBinding :: Core.Binding -> String formatTermBinding binding = let name = Core.unName (Core.bindingName binding) - typeStr = Optionals.cases (Core.bindingTypeScheme binding) "?" (\scheme -> ShowCore.typeScheme scheme) - in (Strings.cat2 (Strings.cat2 (Strings.cat2 " " name) " : ") typeStr) + typeStr = Optionals.cases (Core.bindingTypeScheme binding) "?" (\scheme -> PrintCore.typeScheme scheme) + in (Strings.concat2 (Strings.concat2 (Strings.concat2 " " name) " : ") typeStr) -- | Format a type binding for the lexicon formatTypeBinding :: Graph.Graph -> Core.Binding -> Either Errors.Error String formatTypeBinding graph binding = - Eithers.bind (Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\_a -> _a) (DecodeCore.type_ graph (Core.bindingTerm binding))) (\typ -> Right (Strings.cat2 (Strings.cat2 (Strings.cat2 " " (Core.unName (Core.bindingName binding))) " = ") (ShowCore.type_ typ))) + Eithers.bind (Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\_a -> _a) (DecodeCore.type_ graph (Core.bindingTerm binding))) (\typ -> Right (Strings.concat2 (Strings.concat2 (Strings.concat2 " " (Core.unName (Core.bindingName binding))) " = ") (PrintCore.type_ typ))) -- | Generate encoder or decoder modules for a list of type modules generateCoderModules :: (t0 -> Graph.Graph -> t1 -> Either t2 (Maybe t3)) -> Graph.Graph -> [Packaging.Module] -> [t1] -> t0 -> Either t2 [t3] @@ -129,7 +131,7 @@ let universe = Maps.fromList (Lists.map (\m -> (Packaging.moduleName m, m)) (Lists.concat2 universeModules universeModules)) closureModules = moduleDepsTransitive universe universeModules schemaElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -146,7 +148,7 @@ Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) _ -> Nothing) (Packaging.moduleDefinitions m))) closureModules) dataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -156,7 +158,7 @@ schemaTypes = Eithers.either (\_ -> Maps.empty) (\_r -> _r) (Environment.schemaGraphToTypingEnvironment schemaGraph) allElements = Lists.concat2 schemaElements dataElements graph = Lexical.elementsToGraph bsGraph schemaTypes allElements - in (Eithers.map (\results -> Optionals.cat results) (Eithers.mapList (\m -> codec cx graph m) typeModules)) + in (Eithers.map (\results -> Optionals.givens results) (Eithers.mapList (\m -> codec cx graph m) typeModules)) -- | Generate the lexicon content from a graph generateLexicon :: Graph.Graph -> Either Errors.Error String @@ -167,13 +169,13 @@ partitioned = Lists.partition (\b -> Annotations.isNativeType b) bindings typeBindings = Pairs.first partitioned termBindings = Pairs.second partitioned - sortedPrimitives = Lists.sortOn (\p -> Packaging.primitiveDefinitionName (Graph.primitiveDefinition p)) primitives - sortedTypes = Lists.sortOn (\b -> Core.bindingName b) typeBindings - sortedTerms = Lists.sortOn (\b -> Core.bindingName b) termBindings + sortedPrimitives = Lists.sortBy (\p -> Packaging.primitiveDefinitionName (Graph.primitiveDefinition p)) primitives + sortedTypes = Lists.sortBy (\b -> Core.bindingName b) typeBindings + sortedTerms = Lists.sortBy (\b -> Core.bindingName b) termBindings in (Eithers.bind (Eithers.mapList (\b -> formatTypeBinding graph b) sortedTypes) (\typeLines -> let termLines = Lists.map (\b -> formatTermBinding b) sortedTerms primitiveLines = Lists.map (\p -> formatPrimitive p) sortedPrimitives - in (Right (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 "Primitives:\n" (Strings.unlines primitiveLines)) "\nTypes:\n") (Strings.unlines typeLines)) "\nTerms:\n") (Strings.unlines termLines))))) + in (Right (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Primitives:\n" (Strings.unlines primitiveLines)) "\nTypes:\n") (Strings.unlines typeLines)) "\nTerms:\n") (Strings.unlines termLines))))) -- | Pure core of code generation: given a coder, language, infer flag, bootstrap graph, universe, and modules to generate, produce a list of (filePath, content) pairs. Emission flags doExpand/doHoistCaseStatements/doHoistPolymorphicLetBindings are derived from the absence of the matching LanguageFeature in lang.supportedFeatures: a target that lacks partialApplication needs eta expansion (doExpand=true), and so on. generateSourceFiles :: Ord t0 => ((Packaging.Module -> [Packaging.Definition] -> Typing.InferenceContext -> Graph.Graph -> Either Errors.Error (M.Map t0 t1)) -> Coders.Language -> Bool -> Graph.Graph -> [Packaging.Module] -> [Packaging.Module] -> Typing.InferenceContext -> Either Errors.Error [(t0, t1)]) @@ -186,7 +188,7 @@ doHoistCaseStatements = Logic.not (Sets.member Coders.LanguageFeatureNestedCaseStatements features) doHoistPolymorphicLetBindings = Logic.not (Sets.member Coders.LanguageFeatureNestedPolymorphicLetBindings features) typeModulesToGenerate = - Lists.filter (\mod -> Logic.not (Lists.null (Optionals.cat (Lists.map (\d -> case d of + Lists.filter (\mod -> Logic.not (Lists.null (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -203,7 +205,7 @@ Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) _ -> Nothing) (Packaging.moduleDefinitions mod))))) modsToGenerate termModulesToGenerate = - Lists.filter (\mod -> Logic.not (Lists.null (Optionals.cat (Lists.map (\d -> case d of + Lists.filter (\mod -> Logic.not (Lists.null (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -211,7 +213,7 @@ _ -> Nothing) (Packaging.moduleDefinitions mod))))) modsToGenerate closureMods = moduleDepsTransitive namespaceMap modsToGenerate schemaElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -228,7 +230,7 @@ Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) _ -> Nothing) (Packaging.moduleDefinitions m))) closureMods) dataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -239,7 +241,7 @@ dataGraph = Lexical.elementsToGraph bsGraph schemaTypes2 dataElements in (Eithers.bind (Logic.ifElse (Lists.null typeModulesToGenerate) (Right []) ( let nameLists = - Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just (Packaging.typeDefinitionName v0) _ -> Nothing) (Packaging.moduleDefinitions m))) typeModulesToGenerate in (Eithers.bind (Adapt.schemaGraphToDefinitions constraints schemaGraph nameLists cx) (\schemaResult -> @@ -272,7 +274,7 @@ Packaging.moduleName = (Packaging.moduleName m), Packaging.moduleMetadata = (Packaging.moduleMetadata m), Packaging.moduleDependencies = (Packaging.moduleDependencies m), - Packaging.moduleDefinitions = (Optionals.cat (Lists.map (\d -> case d of + Packaging.moduleDefinitions = (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just (Packaging.DefinitionType v0) Packaging.DefinitionTerm v0 -> Optionals.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { Packaging.termDefinitionName = (Core.bindingName b), @@ -283,7 +285,7 @@ allBindings = Lexical.graphToBindings g1 refreshedMods = Lists.map (\m -> refreshModule allBindings m) termModulesToGenerate dedupDefs = - \defs -> Lists.sortOn (\d -> Packaging.termDefinitionName d) (Maps.elems (Maps.fromList (Lists.map (\d -> (Packaging.termDefinitionName d, d)) defs))) + \defs -> Lists.sortBy (\d -> Packaging.termDefinitionName d) (Maps.elems (Maps.fromList (Lists.map (\d -> (Packaging.termDefinitionName d, d)) defs))) dedupedDefLists = Lists.map dedupDefs defLists in (Eithers.map (\xs -> Lists.concat xs) (Eithers.mapList (\p -> let mod = Pairs.first p @@ -296,7 +298,7 @@ let g0 = modulesToGraph bsGraph kernelModules kernelModules dataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -304,7 +306,47 @@ _ -> Nothing) (Packaging.moduleDefinitions m))) kernelModules) in (Eithers.bind (Inference.inferGraphTypes cx dataElements g0) (\inferResultWithCx -> let g1 = Pairs.first (Pairs.first inferResultWithCx) - in (generateLexicon g1))) + schemaElements = + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of + Packaging.DefinitionType v0 -> Just ((\name -> \typ -> + let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") + dataTerm = + Annotations.normalizeTermAnnotations (Core.TermAnnotated (Core.AnnotatedTerm { + Core.annotatedTermBody = (EncodeCore.type_ typ), + Core.annotatedTermAnnotation = (Annotations.wrapAnnotationMap (Maps.fromList [ + (Constants.keyType, schemaTerm)]))})) + in Core.Binding { + Core.bindingName = name, + Core.bindingTerm = dataTerm, + Core.bindingTypeScheme = (Just (Core.TypeScheme { + Core.typeSchemeVariables = [], + Core.typeSchemeBody = (Core.TypeVariable (Core.Name "hydra.core.Type")), + Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) + _ -> Nothing) (Packaging.moduleDefinitions m))) kernelModules) + typeBoundTerms = Maps.fromList (Lists.map (\b -> (Core.bindingName b, (Core.bindingTerm b))) schemaElements) + typeBoundTypes = + Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) schemaElements)) + g2 = + Graph.Graph { + Graph.graphBoundTerms = (Maps.union typeBoundTerms (Graph.graphBoundTerms g1)), + Graph.graphBoundTypes = (Graph.graphBoundTypes g1), + Graph.graphClassConstraints = (Graph.graphClassConstraints g1), + Graph.graphLambdaVariables = (Graph.graphLambdaVariables g1), + Graph.graphMetadata = (Graph.graphMetadata g1), + Graph.graphPrimitives = (Graph.graphPrimitives g1), + Graph.graphSchemaTypes = (Graph.graphSchemaTypes g1), + Graph.graphTypeVariables = (Graph.graphTypeVariables g1)} + g3 = + Graph.Graph { + Graph.graphBoundTerms = (Graph.graphBoundTerms g2), + Graph.graphBoundTypes = (Maps.union typeBoundTypes (Graph.graphBoundTypes g2)), + Graph.graphClassConstraints = (Graph.graphClassConstraints g2), + Graph.graphLambdaVariables = (Graph.graphLambdaVariables g2), + Graph.graphMetadata = (Graph.graphMetadata g2), + Graph.graphPrimitives = (Graph.graphPrimitives g2), + Graph.graphSchemaTypes = (Graph.graphSchemaTypes g2), + Graph.graphTypeVariables = (Graph.graphTypeVariables g2)} + in (generateLexicon g3))) -- | Perform type inference on modules and reconstruct with inferred types inferModules :: Typing.InferenceContext -> Graph.Graph -> [Packaging.Module] -> [Packaging.Module] -> Either Errors.Error [Packaging.Module] @@ -312,7 +354,7 @@ let g0 = modulesToGraph bsGraph universeMods universeMods dataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -335,7 +377,7 @@ Lists.concat (Lists.map (\m -> let isTarget = Sets.member (Packaging.moduleName m) targetNamespaces bs = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -346,7 +388,7 @@ Lists.concat (Lists.map (\m -> let isTarget = Sets.member (Packaging.moduleName m) targetNamespaces bs = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionPrimitive v0 -> Optionals.map (\impl -> Core.Binding { Core.bindingName = (Packaging.primitiveDefinitionName v0), Core.bindingTerm = impl, @@ -358,7 +400,7 @@ Lists.concat (Lists.map (\m -> let isTarget = Sets.member (Packaging.moduleName m) targetNamespaces bs = - Optionals.cat (Lists.map (\d -> case d of + Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -419,11 +461,11 @@ let closure = Sets.union (transitiveDeps (\m -> Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies m)) nsMap modules) (Sets.fromList (Lists.map (\m -> Packaging.moduleName m) modules)) - in (Optionals.cat (Lists.map (\n -> Maps.lookup n nsMap) (Sets.toList closure))) + in (Optionals.givens (Lists.map (\n -> Maps.lookup n nsMap) (Sets.toList closure))) -- | Convert a module name to a file path (e.g., hydra.core -> hydra/core) moduleNameToPath :: Packaging.ModuleName -> String -moduleNameToPath ns = Strings.intercalate "/" (Strings.splitOn "." (Packaging.unModuleName ns)) +moduleNameToPath ns = Strings.join "/" (Strings.splitOn "." (Packaging.unModuleName ns)) -- | Convert a Module to a JSON string moduleToJson :: M.Map Core.Name Core.Type -> Packaging.Module -> Either Errors.Error String @@ -438,11 +480,11 @@ moduleToSourceModule m = let sourceNs = - Packaging.ModuleName (Strings.cat2 "hydra.sources." (Strings.intercalate "." (Lists.drop 1 (Strings.splitOn "." (Packaging.unModuleName (Packaging.moduleName m)))))) + Packaging.ModuleName (Strings.concat2 "hydra.sources." (Strings.join "." (Lists.drop 1 (Strings.splitOn "." (Packaging.unModuleName (Packaging.moduleName m)))))) modTypeNs = Packaging.ModuleName "hydra.packaging" moduleDef = Packaging.DefinitionTerm (Packaging.TermDefinition { - Packaging.termDefinitionName = (Core.Name (Strings.cat2 (Packaging.unModuleName sourceNs) ".module_")), + Packaging.termDefinitionName = (Core.Name (Strings.concat2 (Packaging.unModuleName sourceNs) ".module_")), Packaging.termDefinitionMetadata = Nothing, Packaging.termDefinitionSignature = (Just (Scoping.typeSchemeToTermSignature (Core.TypeScheme { Core.typeSchemeVariables = [], @@ -452,7 +494,7 @@ in Packaging.Module { Packaging.moduleName = sourceNs, Packaging.moduleMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just (Strings.cat2 "Source module for " (Packaging.unModuleName (Packaging.moduleName m)))), + Packaging.entityMetadataDescription = (Just (Strings.concat2 "Source module for " (Packaging.unModuleName (Packaging.moduleName m)))), Packaging.entityMetadataComments = [], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -470,7 +512,7 @@ let universe = Maps.fromList (Lists.map (\m -> (Packaging.moduleName m, m)) (Lists.concat2 universeModules modules)) closureModules = moduleDepsTransitive universe modules schemaElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -487,7 +529,7 @@ Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) _ -> Nothing) (Packaging.moduleDefinitions m))) closureModules) dataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -497,14 +539,14 @@ schemaTypes = Eithers.either (\_ -> Maps.empty) (\_r -> _r) (Environment.schemaGraphToTypingEnvironment schemaGraph) baseGraph = Lexical.elementsToGraph bsGraph schemaTypes dataElements universeDataElements = - Lists.concat (Lists.map (\m -> Optionals.cat (Lists.map (\d -> case d of + Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), Core.bindingTypeScheme = (Optionals.map Scoping.termSignatureToTypeScheme (Packaging.termDefinitionSignature v0))}) _ -> Nothing) (Packaging.moduleDefinitions m))) universeModules) universeBoundTypes = - Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) universeDataElements)) + Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) universeDataElements)) in Graph.Graph { Graph.graphBoundTerms = (Graph.graphBoundTerms baseGraph), Graph.graphBoundTypes = universeBoundTypes, @@ -518,7 +560,7 @@ -- | Rebuild a module's term definitions using freshly inferred bindings refreshModule :: [Core.Binding] -> Packaging.Module -> Packaging.Module refreshModule inferredElements m = - Logic.ifElse (Logic.not (Logic.not (Lists.null (Optionals.cat (Lists.map (\d -> case d of + Logic.ifElse (Logic.not (Logic.not (Lists.null (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionTerm v0 -> Just (Core.Binding { Core.bindingName = (Packaging.termDefinitionName v0), Core.bindingTerm = (Packaging.termDefinitionBody v0), @@ -527,7 +569,7 @@ Packaging.moduleName = (Packaging.moduleName m), Packaging.moduleMetadata = (Packaging.moduleMetadata m), Packaging.moduleDependencies = (Packaging.moduleDependencies m), - Packaging.moduleDefinitions = (Optionals.cat (Lists.map (\d -> case d of + Packaging.moduleDefinitions = (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just (Packaging.DefinitionType v0) Packaging.DefinitionTerm v0 -> Optionals.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { Packaging.termDefinitionName = (Core.bindingName b), diff --git a/src/main/haskell/Hydra/Constants.hs b/src/main/haskell/Hydra/Constants.hs --- a/src/main/haskell/Hydra/Constants.hs +++ b/src/main/haskell/Hydra/Constants.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -34,10 +35,6 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci - --- | Disable type checking by default, for better performance -debugInference :: Bool -debugInference = True -- | The name used for ignored variables ignoredVariable :: String diff --git a/src/main/haskell/Hydra/Decode/Ast.hs b/src/main/haskell/Hydra/Decode/Ast.hs --- a/src/main/haskell/Hydra/Decode/Ast.hs +++ b/src/main/haskell/Hydra/Decode/Ast.hs @@ -34,7 +34,7 @@ (Core.Name "left", (\input -> Eithers.map (\t -> Ast.AssociativityLeft) (ExtractCore.decodeUnit cx input))), (Core.Name "right", (\input -> Eithers.map (\t -> Ast.AssociativityRight) (ExtractCore.decodeUnit cx input))), (Core.Name "both", (\input -> Eithers.map (\t -> Ast.AssociativityBoth) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -102,7 +102,7 @@ (Core.Name "op", (\input -> Eithers.map (\t -> Ast.ExprOp t) (opExpr cx input))), (Core.Name "brackets", (\input -> Eithers.map (\t -> Ast.ExprBrackets t) (bracketExpr cx input))), (Core.Name "seq", (\input -> Eithers.map (\t -> Ast.ExprSeq t) (seqExpr cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -132,7 +132,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -241,7 +241,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), (Core.Name "doubleBreak", (\input -> Eithers.map (\t -> Ast.WsDoubleBreak) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Coders.hs b/src/main/haskell/Hydra/Decode/Coders.hs --- a/src/main/haskell/Hydra/Decode/Coders.hs +++ b/src/main/haskell/Hydra/Decode/Coders.hs @@ -55,7 +55,7 @@ Maps.fromList [ (Core.Name "encode", (\input -> Eithers.map (\t -> Coders.CoderDirectionEncode) (ExtractCore.decodeUnit cx input))), (Core.Name "decode", (\input -> Eithers.map (\t -> Coders.CoderDirectionDecode) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -80,7 +80,7 @@ ( Core.Name "nestedPolymorphicLetBindings", (\input -> Eithers.map (\t -> Coders.LanguageFeatureNestedPolymorphicLetBindings) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -109,7 +109,7 @@ Maps.fromList [ (Core.Name "pre", (\input -> Eithers.map (\t -> Coders.TraversalOrderPre) (ExtractCore.decodeUnit cx input))), (Core.Name "post", (\input -> Eithers.map (\t -> Coders.TraversalOrderPost) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Core.hs b/src/main/haskell/Hydra/Decode/Core.hs --- a/src/main/haskell/Hydra/Decode/Core.hs +++ b/src/main/haskell/Hydra/Decode/Core.hs @@ -142,7 +142,7 @@ Maps.fromList [ (Core.Name "float32", (\input -> Eithers.map (\t -> Core.FloatTypeFloat32) (ExtractCore.decodeUnit cx input))), (Core.Name "float64", (\input -> Eithers.map (\t -> Core.FloatTypeFloat64) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -176,7 +176,7 @@ _ -> Left (Errors.DecodingError "expected float64 value") _ -> Left (Errors.DecodingError "expected float64 literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -234,7 +234,7 @@ (Core.Name "uint16", (\input -> Eithers.map (\t -> Core.IntegerTypeUint16) (ExtractCore.decodeUnit cx input))), (Core.Name "uint32", (\input -> Eithers.map (\t -> Core.IntegerTypeUint32) (ExtractCore.decodeUnit cx input))), (Core.Name "uint64", (\input -> Eithers.map (\t -> Core.IntegerTypeUint64) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -331,7 +331,7 @@ _ -> Left (Errors.DecodingError "expected uint64 value") _ -> Left (Errors.DecodingError "expected uint64 literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -400,7 +400,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -422,7 +422,7 @@ (Core.Name "float", (\input -> Eithers.map (\t -> Core.LiteralTypeFloat t) (floatType cx input))), (Core.Name "integer", (\input -> Eithers.map (\t -> Core.LiteralTypeInteger t) (integerType cx input))), (Core.Name "string", (\input -> Eithers.map (\t -> Core.LiteralTypeString) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -514,7 +514,7 @@ (Core.Name "unwrap", (\input -> Eithers.map (\t -> Core.TermUnwrap t) (name cx input))), (Core.Name "variable", (\input -> Eithers.map (\t -> Core.TermVariable t) (name cx input))), (Core.Name "wrap", (\input -> Eithers.map (\t -> Core.TermWrap t) (wrappedTerm cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -548,7 +548,7 @@ (Core.Name "variable", (\input -> Eithers.map (\t -> Core.TypeVariable t) (name cx input))), (Core.Name "void", (\input -> Eithers.map (\t -> Core.TypeVoid) (ExtractCore.decodeUnit cx input))), (Core.Name "wrap", (\input -> Eithers.map (\t -> Core.TypeWrap t) (type_ cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -576,7 +576,7 @@ variantMap = Maps.fromList [ (Core.Name "simple", (\input -> Eithers.map (\t -> Core.TypeClassConstraintSimple t) (name cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Docs.hs b/src/main/haskell/Hydra/Decode/Docs.hs --- a/src/main/haskell/Hydra/Decode/Docs.hs +++ b/src/main/haskell/Hydra/Decode/Docs.hs @@ -38,7 +38,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Error/Checking.hs b/src/main/haskell/Hydra/Decode/Error/Checking.hs --- a/src/main/haskell/Hydra/Decode/Error/Checking.hs +++ b/src/main/haskell/Hydra/Decode/Error/Checking.hs @@ -70,7 +70,7 @@ ( Core.Name "untypedTermVariable", (\input -> Eithers.map (\t -> Checking.CheckingErrorUntypedTermVariable t) (untypedTermVariableCheckingError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Error/Core.hs b/src/main/haskell/Hydra/Decode/Error/Core.hs --- a/src/main/haskell/Hydra/Decode/Error/Core.hs +++ b/src/main/haskell/Hydra/Decode/Error/Core.hs @@ -198,7 +198,7 @@ ( Core.Name "typeMismatch", (\input -> Eithers.map (\t -> ErrorCore.InvalidLiteralErrorTypeMismatch t) (literalTypeMismatchError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -245,6 +245,9 @@ Core.Name "invalidTypeLambdaParameterName", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorInvalidTypeLambdaParameterName t) (invalidTypeLambdaParameterNameError cx input))), ( + Core.Name "missingCaseBranches", + (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorMissingCaseBranches t) (missingCaseBranchesError cx input))), + ( Core.Name "nestedTermAnnotation", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorNestedTermAnnotation t) (nestedTermAnnotationError cx input))), ( @@ -272,6 +275,9 @@ Core.Name "undefinedTypeVariableInTypeApplication", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUndefinedTypeVariableInTypeApplication t) (undefinedTypeVariableInTypeApplicationError cx input))), ( + Core.Name "unknownCaseAlternative", + (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnknownCaseAlternative t) (unknownCaseAlternativeError cx input))), + ( Core.Name "unknownPrimitiveName", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnknownPrimitiveName t) (unknownPrimitiveNameError cx input))), ( @@ -280,7 +286,7 @@ ( Core.Name "untypedTermVariable", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUntypedTermVariable t) (untypedTermVariableError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -338,7 +344,7 @@ ( Core.Name "voidInNonBottomPosition", (\input -> Eithers.map (\t -> ErrorCore.InvalidTypeErrorVoidInNonBottomPosition t) (voidInNonBottomPositionError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -377,6 +383,18 @@ ErrorCore.literalTypeMismatchErrorActualType = field_actualType})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.LiteralTypeMismatchError")) (ExtractCore.stripWithDecodingError cx raw) +-- | Decoder for hydra.error.core.MissingCaseBranchesError +missingCaseBranchesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.MissingCaseBranchesError +missingCaseBranchesError cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "variantNames" (ExtractCore.decodeList DecodeCore.name) fieldMap cx) (\field_variantNames -> Right (ErrorCore.MissingCaseBranchesError { + ErrorCore.missingCaseBranchesErrorLocation = field_location, + ErrorCore.missingCaseBranchesErrorTypeName = field_typeName, + ErrorCore.missingCaseBranchesErrorVariantNames = field_variantNames}))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.MissingCaseBranchesError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NestedTermAnnotationError nestedTermAnnotationError cx raw = @@ -572,6 +590,18 @@ ErrorCore.unexpectedTypeVariantErrorExpectedVariant = field_expectedVariant, ErrorCore.unexpectedTypeVariantErrorActualType = field_actualType})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnexpectedTypeVariantError")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeError cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Right (ErrorCore.UnknownCaseAlternativeError { + ErrorCore.unknownCaseAlternativeErrorLocation = field_location, + ErrorCore.unknownCaseAlternativeErrorTypeName = field_typeName, + ErrorCore.unknownCaseAlternativeErrorName = field_name}))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnknownCaseAlternativeError")) (ExtractCore.stripWithDecodingError cx raw) -- | Decoder for hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnknownPrimitiveNameError diff --git a/src/main/haskell/Hydra/Decode/Error/File.hs b/src/main/haskell/Hydra/Decode/Error/File.hs --- a/src/main/haskell/Hydra/Decode/Error/File.hs +++ b/src/main/haskell/Hydra/Decode/Error/File.hs @@ -51,7 +51,7 @@ ( Core.Name "permissionDenied", (\input -> Eithers.map (\t -> ErrorFile.FileErrorPermissionDenied t) (DecodeFile.filePath cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Error/Packaging.hs b/src/main/haskell/Hydra/Decode/Error/Packaging.hs --- a/src/main/haskell/Hydra/Decode/Error/Packaging.hs +++ b/src/main/haskell/Hydra/Decode/Error/Packaging.hs @@ -133,7 +133,7 @@ ( Core.Name "missingDocumentation", (\input -> Eithers.map (\t -> ErrorPackaging.InvalidModuleErrorMissingDocumentation t) (missingDocumentationError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -170,8 +170,11 @@ (\input -> Eithers.map (\t -> ErrorPackaging.InvalidPackageErrorInvalidModule t) (invalidModuleError cx input))), ( Core.Name "invalidPackageName", - (\input -> Eithers.map (\t -> ErrorPackaging.InvalidPackageErrorInvalidPackageName t) (invalidPackageNameError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + (\input -> Eithers.map (\t -> ErrorPackaging.InvalidPackageErrorInvalidPackageName t) (invalidPackageNameError cx input))), + ( + Core.Name "undeclaredDependency", + (\input -> Eithers.map (\t -> ErrorPackaging.InvalidPackageErrorUndeclaredDependency t) (undeclaredDependencyError cx input)))] + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -197,3 +200,15 @@ ErrorPackaging.missingDocumentationErrorModuleName = field_moduleName, ErrorPackaging.missingDocumentationErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.MissingDocumentationError")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyError cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "moduleName" DecodePackaging.moduleName fieldMap cx) (\field_moduleName -> Eithers.bind (ExtractCore.requireField "referencedName" DecodeCore.name fieldMap cx) (\field_referencedName -> Eithers.bind (ExtractCore.requireField "owningModuleName" DecodePackaging.moduleName fieldMap cx) (\field_owningModuleName -> Right (ErrorPackaging.UndeclaredDependencyError { + ErrorPackaging.undeclaredDependencyErrorModuleName = field_moduleName, + ErrorPackaging.undeclaredDependencyErrorReferencedName = field_referencedName, + ErrorPackaging.undeclaredDependencyErrorOwningModuleName = field_owningModuleName}))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.UndeclaredDependencyError")) (ExtractCore.stripWithDecodingError cx raw) diff --git a/src/main/haskell/Hydra/Decode/Error/System.hs b/src/main/haskell/Hydra/Decode/Error/System.hs --- a/src/main/haskell/Hydra/Decode/Error/System.hs +++ b/src/main/haskell/Hydra/Decode/Error/System.hs @@ -47,7 +47,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Errors.hs b/src/main/haskell/Hydra/Decode/Errors.hs --- a/src/main/haskell/Hydra/Decode/Errors.hs +++ b/src/main/haskell/Hydra/Decode/Errors.hs @@ -80,7 +80,7 @@ Core.Name "unexpectedTypeVariant", (\input -> Eithers.map (\t -> Errors.ErrorUnexpectedTypeVariant t) (ErrorCore.unexpectedTypeVariantError cx input))), (Core.Name "unification", (\input -> Eithers.map (\t -> Errors.ErrorUnification t) (unificationError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -115,7 +115,7 @@ ( Core.Name "unexpectedShape", (\input -> Eithers.map (\t -> Errors.ExtractionErrorUnexpectedShape t) (unexpectedShapeError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -136,7 +136,7 @@ ( Core.Name "unification", (\input -> Eithers.map (\t -> Errors.InferenceErrorUnification t) (unificationInferenceError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -256,7 +256,7 @@ ( Core.Name "unexpectedShape", (\input -> Eithers.map (\t -> Errors.ResolutionErrorUnexpectedShape t) (unexpectedShapeError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/File.hs b/src/main/haskell/Hydra/Decode/File.hs --- a/src/main/haskell/Hydra/Decode/File.hs +++ b/src/main/haskell/Hydra/Decode/File.hs @@ -80,7 +80,7 @@ (Core.Name "regular", (\input -> Eithers.map (\t -> File.FileTypeRegular) (ExtractCore.decodeUnit cx input))), (Core.Name "link", (\input -> Eithers.map (\t -> File.FileTypeLink) (ExtractCore.decodeUnit cx input))), (Core.Name "socket", (\input -> Eithers.map (\t -> File.FileTypeSocket) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Json/Model.hs b/src/main/haskell/Hydra/Decode/Json/Model.hs --- a/src/main/haskell/Hydra/Decode/Json/Model.hs +++ b/src/main/haskell/Hydra/Decode/Json/Model.hs @@ -60,7 +60,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Packaging.hs b/src/main/haskell/Hydra/Decode/Packaging.hs --- a/src/main/haskell/Hydra/Decode/Packaging.hs +++ b/src/main/haskell/Hydra/Decode/Packaging.hs @@ -34,7 +34,7 @@ (Core.Name "primitive", (\input -> Eithers.map (\t -> Packaging.DefinitionPrimitive t) (primitiveDefinition cx input))), (Core.Name "term", (\input -> Eithers.map (\t -> Packaging.DefinitionTerm t) (termDefinition cx input))), (Core.Name "type", (\input -> Eithers.map (\t -> Packaging.DefinitionType t) (typeDefinition cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -55,7 +55,7 @@ (\input -> Eithers.map (\t -> Packaging.DefinitionReferencePrimitive t) (DecodeCore.name cx input))), (Core.Name "term", (\input -> Eithers.map (\t -> Packaging.DefinitionReferenceTerm t) (DecodeCore.name cx input))), (Core.Name "type", (\input -> Eithers.map (\t -> Packaging.DefinitionReferenceType t) (DecodeCore.name cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -75,7 +75,7 @@ (Core.Name "runtime", (\input -> Eithers.map (\t -> Packaging.DependencyScopeRuntime) (ExtractCore.decodeUnit cx input))), (Core.Name "test", (\input -> Eithers.map (\t -> Packaging.DependencyScopeTest) (ExtractCore.decodeUnit cx input))), (Core.Name "tool", (\input -> Eithers.map (\t -> Packaging.DependencyScopeTool) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -131,7 +131,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -303,7 +303,7 @@ (Core.Name "exact", (\input -> Eithers.map (\t -> Packaging.VersionSpecifierExact t) (version cx input))), (Core.Name "atLeast", (\input -> Eithers.map (\t -> Packaging.VersionSpecifierAtLeast t) (version cx input))), (Core.Name "range", (\input -> Eithers.map (\t -> Packaging.VersionSpecifierRange t) (versionRange cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Parsing.hs b/src/main/haskell/Hydra/Decode/Parsing.hs --- a/src/main/haskell/Hydra/Decode/Parsing.hs +++ b/src/main/haskell/Hydra/Decode/Parsing.hs @@ -51,7 +51,7 @@ Maps.fromList [ (Core.Name "success", (\input -> Eithers.map (\t -> Parsing.ParseResultSuccess t) (parseSuccess a cx input))), (Core.Name "failure", (\input -> Eithers.map (\t -> Parsing.ParseResultFailure t) (parseError cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Paths.hs b/src/main/haskell/Hydra/Decode/Paths.hs --- a/src/main/haskell/Hydra/Decode/Paths.hs +++ b/src/main/haskell/Hydra/Decode/Paths.hs @@ -158,7 +158,7 @@ Core.Name "injectionTerm", (\input -> Eithers.map (\t -> Paths.SubtermStepInjectionTerm) (ExtractCore.decodeUnit cx input))), (Core.Name "wrappedTerm", (\input -> Eithers.map (\t -> Paths.SubtermStepWrappedTerm) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -254,7 +254,7 @@ (Core.Name "setElement", (\input -> Eithers.map (\t -> Paths.SubtypeStepSetElement) (ExtractCore.decodeUnit cx input))), (Core.Name "unionField", (\input -> Eithers.map (\t -> Paths.SubtypeStepUnionField t) (DecodeCore.name cx input))), (Core.Name "wrappedType", (\input -> Eithers.map (\t -> Paths.SubtypeStepWrappedType) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Query.hs b/src/main/haskell/Hydra/Decode/Query.hs --- a/src/main/haskell/Hydra/Decode/Query.hs +++ b/src/main/haskell/Hydra/Decode/Query.hs @@ -46,7 +46,7 @@ ( Core.Name "greaterThanOrEqual", (\input -> Eithers.map (\t -> Query.ComparisonConstraintGreaterThanOrEqual) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -88,7 +88,7 @@ (Core.Name "term", (\input -> Eithers.map (\t -> Query.NodeTerm t) (DecodeCore.term cx input))), (Core.Name "variable", (\input -> Eithers.map (\t -> Query.NodeVariable t) (variable cx input))), (Core.Name "wildcard", (\input -> Eithers.map (\t -> Query.NodeWildcard) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -107,7 +107,7 @@ (Core.Name "step", (\input -> Eithers.map (\t -> Query.PathStep t) (step cx input))), (Core.Name "regex", (\input -> Eithers.map (\t -> Query.PathRegex t) (regexSequence cx input))), (Core.Name "inverse", (\input -> Eithers.map (\t -> Query.PathInverse t) (path cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -143,7 +143,7 @@ Core.Name "disjunction", (\input -> Eithers.map (\t -> Query.PatternDisjunction t) (ExtractCore.decodeList pattern cx input))), (Core.Name "graph", (\input -> Eithers.map (\t -> Query.PatternGraph t) (graphPattern cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -229,7 +229,7 @@ _ -> Left (Errors.DecodingError "expected int32 literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), (Core.Name "range", (\input -> Eithers.map (\t -> Query.RegexQuantifierRange t) (range cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -259,7 +259,7 @@ (Core.Name "edge", (\input -> Eithers.map (\t -> Query.StepEdge t) (edge cx input))), (Core.Name "project", (\input -> Eithers.map (\t -> Query.StepProject t) (DecodeCore.projection cx input))), (Core.Name "compare", (\input -> Eithers.map (\t -> Query.StepCompare t) (comparisonConstraint cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Regex.hs b/src/main/haskell/Hydra/Decode/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/Regex.hs @@ -0,0 +1,199 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.regex + +module Hydra.Decode.Regex where + +import qualified Hydra.Core as Core +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.Graph as Graph +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Regex as Regex +import qualified Hydra.Rewriting as Rewriting +import qualified Hydra.Util as Util +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Decoder for hydra.regex.Alternation +alternation :: Graph.Graph -> Core.Term -> Either Errors.DecodingError [Regex.RegexSequence] +alternation = ExtractCore.decodeList regexSequence + +-- | Decoder for hydra.regex.Atom +atom :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.Atom +atom cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermInject v0 -> + let field = Core.injectionField v0 + fname = Core.fieldName field + fterm = Core.fieldTerm field + variantMap = + Maps.fromList [ + ( + Core.Name "literal", + (\input -> Eithers.map (\t -> Regex.AtomLiteral t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + (Core.Name "any", (\input -> Eithers.map (\t -> Regex.AtomAny) (ExtractCore.decodeUnit cx input))), + (Core.Name "anchorStart", (\input -> Eithers.map (\t -> Regex.AtomAnchorStart) (ExtractCore.decodeUnit cx input))), + (Core.Name "anchorEnd", (\input -> Eithers.map (\t -> Regex.AtomAnchorEnd) (ExtractCore.decodeUnit cx input))), + (Core.Name "group", (\input -> Eithers.map (\t -> Regex.AtomGroup t) (alternation cx input))), + (Core.Name "class", (\input -> Eithers.map (\t -> Regex.AtomClass t) (characterClass cx input)))] + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.CharacterClass +characterClass :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.CharacterClass +characterClass cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "negated" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralBoolean v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected boolean literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_negated -> Eithers.bind (ExtractCore.requireField "items" (ExtractCore.decodeList classItem) fieldMap cx) (\field_items -> Right (Regex.CharacterClass { + Regex.characterClassNegated = field_negated, + Regex.characterClassItems = field_items})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.regex.CharacterClass")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.CharacterRange +characterRange :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.CharacterRange +characterRange cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "from" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_from -> Eithers.bind (ExtractCore.requireField "to" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_to -> Right (Regex.CharacterRange { + Regex.characterRangeFrom = field_from, + Regex.characterRangeTo = field_to})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.regex.CharacterRange")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.ClassItem +classItem :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.ClassItem +classItem cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermInject v0 -> + let field = Core.injectionField v0 + fname = Core.fieldName field + fterm = Core.fieldTerm field + variantMap = + Maps.fromList [ + ( + Core.Name "character", + (\input -> Eithers.map (\t -> Regex.ClassItemCharacter t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + (Core.Name "range", (\input -> Eithers.map (\t -> Regex.ClassItemRange t) (characterRange cx input)))] + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.Quantified +quantified :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.Quantified +quantified cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "atom" atom fieldMap cx) (\field_atom -> Eithers.bind (ExtractCore.requireField "quantifier" quantifier fieldMap cx) (\field_quantifier -> Right (Regex.Quantified { + Regex.quantifiedAtom = field_atom, + Regex.quantifiedQuantifier = field_quantifier})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.regex.Quantified")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.Quantifier +quantifier :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.Quantifier +quantifier cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermInject v0 -> + let field = Core.injectionField v0 + fname = Core.fieldName field + fterm = Core.fieldTerm field + variantMap = + Maps.fromList [ + (Core.Name "one", (\input -> Eithers.map (\t -> Regex.QuantifierOne) (ExtractCore.decodeUnit cx input))), + (Core.Name "zeroOrOne", (\input -> Eithers.map (\t -> Regex.QuantifierZeroOrOne) (ExtractCore.decodeUnit cx input))), + (Core.Name "zeroOrMore", (\input -> Eithers.map (\t -> Regex.QuantifierZeroOrMore) (ExtractCore.decodeUnit cx input))), + (Core.Name "oneOrMore", (\input -> Eithers.map (\t -> Regex.QuantifierOneOrMore) (ExtractCore.decodeUnit cx input))), + ( + Core.Name "exactly", + (\input -> Eithers.map (\t -> Regex.QuantifierExactly t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + ( + Core.Name "atLeast", + (\input -> Eithers.map (\t -> Regex.QuantifierAtLeast t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + (Core.Name "range", (\input -> Eithers.map (\t -> Regex.QuantifierRange_ t) (quantifierRange cx input)))] + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.QuantifierRange +quantifierRange :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.QuantifierRange +quantifierRange cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "min" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_min -> Eithers.bind (ExtractCore.requireField "max" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int32 value") + _ -> Left (Errors.DecodingError "expected int32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_max -> Right (Regex.QuantifierRange { + Regex.quantifierRangeMin = field_min, + Regex.quantifierRangeMax = field_max})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.regex.QuantifierRange")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.regex.Regex +regex :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Regex.Alternation +regex = alternation + +-- | Decoder for hydra.regex.RegexSequence +regexSequence :: Graph.Graph -> Core.Term -> Either Errors.DecodingError [Regex.Quantified] +regexSequence = ExtractCore.decodeList quantified diff --git a/src/main/haskell/Hydra/Decode/Typed.hs b/src/main/haskell/Hydra/Decode/Typed.hs --- a/src/main/haskell/Hydra/Decode/Typed.hs +++ b/src/main/haskell/Hydra/Decode/Typed.hs @@ -28,6 +28,13 @@ Typed.typedBindingTerm = field_term})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typed.TypedBinding")) (ExtractCore.stripWithDecodingError cx raw) +-- | Decoder for hydra.typed.TypedName +typedName :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typed.TypedName a) +typedName a cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermWrap v0 -> Eithers.map (\b -> Typed.TypedName b) (DecodeCore.name cx (Core.wrappedTermBody v0)) + _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typed.TypedTerm typedTerm :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typed.TypedTerm a) typedTerm a cx raw = diff --git a/src/main/haskell/Hydra/Decode/Util.hs b/src/main/haskell/Hydra/Decode/Util.hs --- a/src/main/haskell/Hydra/Decode/Util.hs +++ b/src/main/haskell/Hydra/Decode/Util.hs @@ -34,7 +34,7 @@ (Core.Name "pascal", (\input -> Eithers.map (\t -> Util.CaseConventionPascal) (ExtractCore.decodeUnit cx input))), (Core.Name "lowerSnake", (\input -> Eithers.map (\t -> Util.CaseConventionLowerSnake) (ExtractCore.decodeUnit cx input))), (Core.Name "upperSnake", (\input -> Eithers.map (\t -> Util.CaseConventionUpperSnake) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -53,7 +53,7 @@ (Core.Name "lessThan", (\input -> Eithers.map (\t -> Util.ComparisonLessThan) (ExtractCore.decodeUnit cx input))), (Core.Name "equalTo", (\input -> Eithers.map (\t -> Util.ComparisonEqualTo) (ExtractCore.decodeUnit cx input))), (Core.Name "greaterThan", (\input -> Eithers.map (\t -> Util.ComparisonGreaterThan) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -90,7 +90,7 @@ _ -> Left (Errors.DecodingError "expected int32 value") _ -> Left (Errors.DecodingError "expected int32 literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Variants.hs b/src/main/haskell/Hydra/Decode/Variants.hs --- a/src/main/haskell/Hydra/Decode/Variants.hs +++ b/src/main/haskell/Hydra/Decode/Variants.hs @@ -36,7 +36,7 @@ (Core.Name "float", (\input -> Eithers.map (\t -> Variants.LiteralVariantFloat) (ExtractCore.decodeUnit cx input))), (Core.Name "integer", (\input -> Eithers.map (\t -> Variants.LiteralVariantInteger) (ExtractCore.decodeUnit cx input))), (Core.Name "string", (\input -> Eithers.map (\t -> Variants.LiteralVariantString) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -77,7 +77,7 @@ (Core.Name "unwrap", (\input -> Eithers.map (\t -> Variants.TermVariantUnwrap) (ExtractCore.decodeUnit cx input))), (Core.Name "variable", (\input -> Eithers.map (\t -> Variants.TermVariantVariable) (ExtractCore.decodeUnit cx input))), (Core.Name "wrap", (\input -> Eithers.map (\t -> Variants.TermVariantWrap) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -113,7 +113,7 @@ (Core.Name "variable", (\input -> Eithers.map (\t -> Variants.TypeVariantVariable) (ExtractCore.decodeUnit cx input))), (Core.Name "void", (\input -> Eithers.map (\t -> Variants.TypeVariantVoid) (ExtractCore.decodeUnit cx input))), (Core.Name "wrap", (\input -> Eithers.map (\t -> Variants.TypeVariantWrap) (ExtractCore.decodeUnit cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decode/Yaml/Model.hs b/src/main/haskell/Hydra/Decode/Yaml/Model.hs --- a/src/main/haskell/Hydra/Decode/Yaml/Model.hs +++ b/src/main/haskell/Hydra/Decode/Yaml/Model.hs @@ -33,7 +33,7 @@ (Core.Name "mapping", (\input -> Eithers.map (\t -> Model.NodeMapping t) (ExtractCore.decodeMap node node cx input))), (Core.Name "scalar", (\input -> Eithers.map (\t -> Model.NodeScalar t) (scalar cx input))), (Core.Name "sequence", (\input -> Eithers.map (\t -> Model.NodeSequence t) (ExtractCore.decodeList node cx input)))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) @@ -89,7 +89,7 @@ Core.LiteralString v2 -> Right v2 _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input))))] - in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.cat [ + in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) diff --git a/src/main/haskell/Hydra/Decoding.hs b/src/main/haskell/Hydra/Decoding.hs --- a/src/main/haskell/Hydra/Decoding.hs +++ b/src/main/haskell/Hydra/Decoding.hs @@ -29,18 +29,18 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Names as Names import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Predicates as Predicates +import qualified Hydra.Print.Core as PrintCore 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.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -116,7 +116,7 @@ let rtype = decoderFullResultTypeNamed (Core.bindingName b) typ rawBody = decodeTypeNamed (Core.bindingName b) typ rtype description = - Strings.cat [ + Strings.concat [ "Decoder for ", (Core.unName (Core.bindingName b))] in (Right (Core.Binding { @@ -126,17 +126,10 @@ -- | Generate a binding name for a decoder function from a type name decodeBindingName :: Core.Name -> Core.Name -decodeBindingName n = - - let parts = Strings.splitOn "." (Core.unName n) - localPart = Formatting.decapitalize (Names.localNameOf n) - localResult = Core.Name localPart - in (Optionals.cases (Lists.maybeInit parts) localResult (\nsParts -> Optionals.cases (Lists.uncons nsParts) localResult (\nsUc -> - let tail = Pairs.second nsUc - in (Core.Name (Strings.intercalate "." (Lists.concat2 [ - "hydra", - "decode"] (Lists.concat2 tail [ - localPart]))))))) +decodeBindingName = + Names.derivedBindingName [ + "hydra", + "decode"] True -- | Generate a decoder for an Either type decodeEitherType :: Core.EitherType -> Core.Term @@ -455,7 +448,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "float32", " literal"])))})))), @@ -470,7 +463,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "float32", " value"])))})))), @@ -546,7 +539,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "float64", " literal"])))})))), @@ -561,7 +554,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "float64", " value"])))})))), @@ -638,7 +631,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "bigint", " literal"])))})))), @@ -653,7 +646,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "bigint", " value"])))})))), @@ -729,7 +722,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int8", " literal"])))})))), @@ -744,7 +737,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int8", " value"])))})))), @@ -820,7 +813,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int16", " literal"])))})))), @@ -835,7 +828,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int16", " value"])))})))), @@ -911,7 +904,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int32", " literal"])))})))), @@ -926,7 +919,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int32", " value"])))})))), @@ -1002,7 +995,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int64", " literal"])))})))), @@ -1017,7 +1010,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "int64", " value"])))})))), @@ -1093,7 +1086,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint8", " literal"])))})))), @@ -1108,7 +1101,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint8", " value"])))})))), @@ -1184,7 +1177,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint16", " literal"])))})))), @@ -1199,7 +1192,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint16", " value"])))})))), @@ -1275,7 +1268,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint32", " literal"])))})))), @@ -1290,7 +1283,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint32", " value"])))})))), @@ -1366,7 +1359,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint64", " literal"])))})))), @@ -1381,7 +1374,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected ", "uint64", " value"])))})))), @@ -1509,7 +1502,7 @@ -- | Transform a type module into a decoder module decodeModule :: t0 -> Graph.Graph -> Packaging.Module -> Either Errors.Error (Maybe Packaging.Module) decodeModule cx graph mod = - Eithers.bind (filterTypeBindings cx graph (Optionals.cat (Lists.map (\d -> case d of + Eithers.bind (filterTypeBindings cx graph (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -1526,11 +1519,11 @@ Core.typeSchemeConstraints = Nothing}))}) (Packaging.typeDefinitionName v0) (Core.typeSchemeBody (Packaging.typeDefinitionBody v0))) _ -> Nothing) (Packaging.moduleDefinitions mod)))) (\typeBindings -> Logic.ifElse (Lists.null typeBindings) (Right Nothing) (Eithers.bind (Eithers.mapList (\b -> Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\x -> x) (decodeBinding cx graph b)) typeBindings) (\decodedBindings -> let allDecodedDeps = - Lists.nub (Lists.map decodeModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))) + Lists.distinct (Lists.map decodeModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))) in (Right (Just (Packaging.Module { Packaging.moduleName = (decodeModuleName (Packaging.moduleName mod)), Packaging.moduleMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just (Strings.cat [ + Packaging.entityMetadataDescription = (Just (Strings.concat [ "Term decoders for ", (Packaging.unModuleName (Packaging.moduleName mod))])), Packaging.entityMetadataComments = [], @@ -1552,13 +1545,10 @@ -- | Generate a decoder module name from a source module name decodeModuleName :: Packaging.ModuleName -> Packaging.ModuleName -decodeModuleName ns = - - let parts = Strings.splitOn "." (Packaging.unModuleName ns) - fallback = Packaging.ModuleName (Packaging.unModuleName ns) - in (Optionals.cases (Lists.uncons parts) fallback (\uc -> Packaging.ModuleName (Strings.cat [ - "hydra.decode.", - (Strings.intercalate "." (Pairs.second uc))]))) +decodeModuleName = + Names.derivedModuleName [ + "hydra", + "decode"] True -- | Generate a decoder for a pair type decodePairType :: Core.PairType -> Core.Term @@ -1604,7 +1594,7 @@ Core.applicationArgument = (Core.TermVariable (Core.Name "fieldMap"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))}) localVarName = - \ft -> Core.Name (Strings.cat [ + \ft -> Core.Name (Strings.concat [ "field_", (Core.unName (Core.fieldTypeName ft))]) toFieldLambda = @@ -1668,7 +1658,7 @@ Core.typeApplicationTermBody = (Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), - Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.cat [ + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Strings.concat [ "expected a record of type ", (Core.unName tname)])))})))), Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError"))})), @@ -1968,7 +1958,7 @@ Core.typeApplicationTermBody = (Core.TermEither (Left (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), Core.wrappedTermBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.cat")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.concat")), Core.applicationArgument = (Core.TermList [ Core.TermLiteral (Core.LiteralString "no such field "), (Core.TermApplication (Core.Application { @@ -2206,7 +2196,7 @@ let typeVars = collectTypeVariables typ allOrdVars = collectOrdConstrainedVariables typ - ordVars = Lists.filter (\v -> Lists.elem v typeVars) allOrdVars + ordVars = Lists.filter (\v -> Lists.member v typeVars) allOrdVars constraints = Logic.ifElse (Lists.null ordVars) Nothing (Just (Maps.fromList (Lists.map (\v -> ( v, @@ -2224,7 +2214,7 @@ let typeVars = collectTypeVariables typ allOrdVars = collectOrdConstrainedVariables typ - ordVars = Lists.filter (\v -> Lists.elem v typeVars) allOrdVars + ordVars = Lists.filter (\v -> Lists.member v typeVars) allOrdVars constraints = Logic.ifElse (Lists.null ordVars) Nothing (Just (Maps.fromList (Lists.map (\v -> ( v, @@ -2239,7 +2229,7 @@ -- | Filter bindings to only decodable type definitions filterTypeBindings :: t0 -> Graph.Graph -> [Core.Binding] -> Either Errors.Error [Core.Binding] filterTypeBindings cx graph bindings = - Eithers.map Optionals.cat (Eithers.mapList (isDecodableBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) + Eithers.map Optionals.givens (Eithers.mapList (isDecodableBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) -- | Check if a binding is decodable (serializable type) isDecodableBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error (Maybe Core.Binding) diff --git a/src/main/haskell/Hydra/Dependencies.hs b/src/main/haskell/Hydra/Dependencies.hs --- a/src/main/haskell/Hydra/Dependencies.hs +++ b/src/main/haskell/Hydra/Dependencies.hs @@ -4,8 +4,10 @@ module Hydra.Dependencies where +import qualified Hydra.Annotations as Annotations import qualified Hydra.Ast as Ast import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants import qualified Hydra.Core as Core import qualified Hydra.Docs as Docs import qualified Hydra.Error.Checking as Checking @@ -26,6 +28,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -34,6 +37,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths 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.Sorting as Sorting @@ -59,7 +63,7 @@ definitionsWithDependencies cx graph original = let depNames = \el -> Sets.toList (termDependencyNames True False False (Core.bindingTerm el)) - allDepNames = Lists.nub (Lists.concat2 (Lists.map Core.bindingName original) (Lists.concat (Lists.map depNames original))) + allDepNames = Lists.distinct (Lists.concat2 (Lists.map Core.bindingName original) (Lists.concat (Lists.map depNames original))) in (Eithers.mapList (\name -> Lexical.requireBinding graph name) allDepNames) -- | Flatten nested let expressions @@ -94,8 +98,8 @@ Core.TermLet v0 -> let bindings1 = Core.letBindings v0 body1 = Core.letBody v0 - prefix = Strings.cat2 (Core.unName key0) "_" - qualify = \n -> Core.Name (Strings.cat2 prefix (Core.unName n)) + prefix = Strings.concat2 (Core.unName key0) "_" + qualify = \n -> Core.Name (Strings.concat2 prefix (Core.unName n)) toSubstPair = \b -> (Core.bindingName b, (qualify (Core.bindingName b))) subst = Maps.fromList (Lists.map toSubstPair bindings1) replaceVars = Variables.substituteVariables subst @@ -150,7 +154,7 @@ \recurse -> \typ2 -> let afterRecurse = \tr -> case tr of - Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 schema) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "No such type in schema: " (Core.unName v0))))) (inlineType schema) + Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 schema) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "No such type in schema: " (Core.unName v0))))) (inlineType schema) _ -> Right tr in (Eithers.bind (recurse typ2) (\tr -> afterRecurse tr)) in (Rewriting.rewriteTypeM f typ) @@ -202,7 +206,7 @@ let bindingMap = Maps.fromList (Lists.map (\b -> (Core.bindingName b, (Core.bindingTerm b))) (Core.letBindings l)) rootName = Core.Name "[[[root]]]" adj = - \n -> Sets.intersection (Sets.fromList (Maps.keys bindingMap)) (Variables.freeVariablesInTerm (Logic.ifElse (Equality.equal n rootName) (Core.letBody l) (Optionals.fromOptional Core.TermUnit (Maps.lookup n bindingMap)))) + \n -> Sets.intersection (Sets.fromList (Maps.keys bindingMap)) (Variables.freeVariablesInTerm (Logic.ifElse (Equality.equal n rootName) (Core.letBody l) (Optionals.withDefault Core.TermUnit (Maps.lookup n bindingMap)))) reachable = Sorting.findReachableNodes adj rootName prunedBindings = Lists.filter (\b -> Sets.member (Core.bindingName b) reachable) (Core.letBindings l) in Core.Let { @@ -291,7 +295,7 @@ let addName = \acc -> \name -> let local = Names.localNameOf name - group = Optionals.fromOptional Sets.empty (Maps.lookup local acc) + group = Optionals.withDefault Sets.empty (Maps.lookup local acc) in (Maps.insert local (Sets.insert name group) acc) groupNamesByLocal = \names -> Lists.foldl addName Maps.empty names groups = groupNamesByLocal original @@ -301,7 +305,7 @@ names = Pairs.second localNames rangeFrom = \start -> Lists.cons start (rangeFrom (Math.add start 1)) rename = - \name -> \i -> (name, (Core.Name (Logic.ifElse (Equality.gt i 1) (Strings.cat2 local (Literals.showInt32 i)) local))) + \name -> \i -> (name, (Core.Name (Logic.ifElse (Ordering.gt i 1) (Strings.concat2 local (Literals.showInt32 i)) local))) in (Lists.zipWith rename (Sets.toList names) (rangeFrom 1)) in (Maps.fromList (Lists.concat (Lists.map renameGroup (Maps.toList groups)))) @@ -311,17 +315,14 @@ let bindings = Maps.toList bindingMap keys = Sets.fromList (Lists.map Pairs.first bindings) - hasTypeAnnotation = - \term -> case term of - Core.TermAnnotated v0 -> hasTypeAnnotation (Core.annotatedTermBody v0) - _ -> False + hasTypeAnnotation = \term -> Optionals.isGiven (Annotations.getTermAnnotation Constants.keyType term) depsOf = \nameAndTerm -> let name = Pairs.first nameAndTerm term = Pairs.second nameAndTerm in (name, (Logic.ifElse (hasTypeAnnotation term) [] (Sets.toList (Sets.intersection keys (Variables.freeVariablesInTerm term))))) toPair = - \name -> (name, (Optionals.fromOptional (Core.TermLiteral (Core.LiteralString "Impossible!")) (Maps.lookup name bindingMap))) + \name -> (name, (Optionals.withDefault (Core.TermLiteral (Core.LiteralString "Impossible!")) (Maps.lookup name bindingMap))) in (Lists.map (Lists.map toPair) (Sorting.topologicalSortComponents (Lists.map depsOf bindings))) -- | Topological sort of bindings based on their dependencies. Returns `Right` with a flat order when the dependency graph is acyclic; returns `Left` with the cyclic SCCs when it is not. Use this variant when the consumer needs a strict acyclic ordering and must reject cycles (e.g. import resolution); use `topologicalSortBindingMap` when mutual recursion should be packaged into SCC groups instead. @@ -341,7 +342,7 @@ (Sets.toList (typeDependencyNames False (Core.typeSchemeBody (Packaging.typeDefinitionBody def))))) nameToDef = Maps.fromList (Lists.map (\d -> (Packaging.typeDefinitionName d, d)) defs) sorted = Sorting.topologicalSortComponents (Lists.map toPair defs) - in (Lists.map (\names -> Optionals.cat (Lists.map (\n -> Maps.lookup n nameToDef) names)) sorted) + in (Lists.map (\names -> Optionals.givens (Lists.map (\n -> Maps.lookup n nameToDef) names)) sorted) -- | Collect all type names referenced by a type. The boolean controls whether type-scheme references (free variables in type expressions) are included alongside structural references typeDependencyNames :: Bool -> Core.Type -> S.Set Core.Name diff --git a/src/main/haskell/Hydra/Differentiation.hs b/src/main/haskell/Hydra/Differentiation.hs --- a/src/main/haskell/Hydra/Differentiation.hs +++ b/src/main/haskell/Hydra/Differentiation.hs @@ -26,6 +26,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Strip as Strip import qualified Hydra.System as System diff --git a/src/main/haskell/Hydra/Dsl/Analysis.hs b/src/main/haskell/Hydra/Dsl/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Analysis.hs @@ -0,0 +1,309 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.analysis + +module Hydra.Dsl.Analysis where + +import qualified Hydra.Analysis as Analysis +import qualified Hydra.Annotations as Annotations +import qualified Hydra.Arity as Arity +import qualified Hydra.Ast as Ast +import qualified Hydra.Checking as Checking +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Dependencies as Dependencies +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Annotations as DslAnnotations +import qualified Hydra.Dsl.Arity as DslArity +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Checking as DslChecking +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Dependencies as DslDependencies +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as DslErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Predicates as DslPredicates +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as ErrorChecking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Predicates as Predicates +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.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Set as S + +-- | DSL reference to hydra.analysis.addNamesToModuleNames +addNamesToModuleNames :: Typed.TypedTerm (Packaging.ModuleName -> t0) -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm (Util.ModuleNames t0) -> Typed.TypedTerm (Util.ModuleNames t0) +addNamesToModuleNames arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.addNamesToModuleNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.analysis.analyzeFunctionTerm +analyzeFunctionTerm :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t0) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t1 (Typing.FunctionStructure t0)) +analyzeFunctionTerm arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.analyzeFunctionTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) + +-- | DSL reference to hydra.analysis.analyzeFunctionTermWith +analyzeFunctionTermWith :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t0) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t1 (Typing.FunctionStructure t0)) +analyzeFunctionTermWith arg0 arg1 arg2 arg3 arg4 arg5 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.analyzeFunctionTermWith")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})) + +-- | DSL reference to hydra.analysis.analyzeFunctionTermWithFinish +analyzeFunctionTermWithFinish :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm t0 -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t1 (Typing.FunctionStructure t0)) +analyzeFunctionTermWithFinish arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.analyzeFunctionTermWithFinish")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})), + Core.applicationArgument = (Typed.unTypedTerm arg6)})), + Core.applicationArgument = (Typed.unTypedTerm arg7)})), + Core.applicationArgument = (Typed.unTypedTerm arg8)})) + +-- | DSL reference to hydra.analysis.analyzeFunctionTermWithGather +analyzeFunctionTermWithGather :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t0) -> Typed.TypedTerm Bool -> Typed.TypedTerm t0 -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t1 (Typing.FunctionStructure t0)) +analyzeFunctionTermWithGather arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.analyzeFunctionTermWithGather")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})), + Core.applicationArgument = (Typed.unTypedTerm arg6)})), + Core.applicationArgument = (Typed.unTypedTerm arg7)})), + Core.applicationArgument = (Typed.unTypedTerm arg8)})), + Core.applicationArgument = (Typed.unTypedTerm arg9)})), + Core.applicationArgument = (Typed.unTypedTerm arg10)})), + Core.applicationArgument = (Typed.unTypedTerm arg11)})) + +-- | DSL reference to hydra.analysis.definitionDependencyModuleNames +definitionDependencyModuleNames :: Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm (S.Set Packaging.ModuleName) +definitionDependencyModuleNames arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.definitionDependencyModuleNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.analysis.dependencyModuleNames +dependencyModuleNames :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (Either Errors.Error (S.Set Packaging.ModuleName)) +dependencyModuleNames arg0 arg1 arg2 arg3 arg4 arg5 arg6 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.dependencyModuleNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})), + Core.applicationArgument = (Typed.unTypedTerm arg6)})) + +-- | DSL reference to hydra.analysis.gatherApplications +gatherApplications :: Typed.TypedTerm Core.Term -> Typed.TypedTerm ([Core.Term], Core.Term) +gatherApplications arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.gatherApplications")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.analysis.gatherArgs +gatherArgs :: Typed.TypedTerm Core.Term -> Typed.TypedTerm [Core.Term] -> Typed.TypedTerm (Core.Term, [Core.Term]) +gatherArgs arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.gatherArgs")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.analysis.gatherArgsWithTypeApps +gatherArgsWithTypeApps :: Typed.TypedTerm Core.Term -> Typed.TypedTerm [Core.Term] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Core.Term, ([Core.Term], [Core.Type])) +gatherArgsWithTypeApps arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.gatherArgsWithTypeApps")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.analysis.isSelfTailRecursive +isSelfTailRecursive :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isSelfTailRecursive arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.isSelfTailRecursive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.analysis.isSimpleAssignment +isSimpleAssignment :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isSimpleAssignment arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.isSimpleAssignment")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.analysis.isTailRecursiveInTailPosition +isTailRecursiveInTailPosition :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isTailRecursiveInTailPosition arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.isTailRecursiveInTailPosition")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.analysis.moduleContainsBinaryLiterals +moduleContainsBinaryLiterals :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Bool +moduleContainsBinaryLiterals arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.moduleContainsBinaryLiterals")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.analysis.moduleContainsDecimalLiterals +moduleContainsDecimalLiterals :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Bool +moduleContainsDecimalLiterals arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.moduleContainsDecimalLiterals")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.analysis.moduleDependencyModuleNames +moduleDependencyModuleNames :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Packaging.Module -> Typed.TypedTerm (Either Errors.Error (S.Set Packaging.ModuleName)) +moduleDependencyModuleNames arg0 arg1 arg2 arg3 arg4 arg5 arg6 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.moduleDependencyModuleNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})), + Core.applicationArgument = (Typed.unTypedTerm arg6)})) + +-- | DSL reference to hydra.analysis.moduleNamesForDefinitions +moduleNamesForDefinitions :: Typed.TypedTerm (Packaging.ModuleName -> t0) -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm (Util.ModuleNames t0) +moduleNamesForDefinitions arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.analysis.moduleNamesForDefinitions")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) diff --git a/src/main/haskell/Hydra/Dsl/Annotations.hs b/src/main/haskell/Hydra/Dsl/Annotations.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Annotations.hs @@ -0,0 +1,326 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.annotations + +module Hydra.Dsl.Annotations where + +import qualified Hydra.Annotations as Annotations +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.annotations.aggregateAnnotations +aggregateAnnotations :: Ord t2 => (Typed.TypedTerm (t0 -> Maybe t1) -> Typed.TypedTerm (t1 -> t0) -> Typed.TypedTerm (t1 -> M.Map t2 t3) -> Typed.TypedTerm t0 -> Typed.TypedTerm (M.Map t2 t3)) +aggregateAnnotations arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.aggregateAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.annotations.commentsFromBinding +commentsFromBinding :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Binding -> Typed.TypedTerm (Either Errors.Error (Maybe String)) +commentsFromBinding arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.commentsFromBinding")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.commentsFromFieldType +commentsFromFieldType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.FieldType -> Typed.TypedTerm (Either Errors.Error (Maybe String)) +commentsFromFieldType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.commentsFromFieldType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.getAnnotationMap +getAnnotationMap :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (M.Map Core.Name Core.Term) +getAnnotationMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getAnnotationMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.getDescription +getDescription :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (Either Errors.Error (Maybe String)) +getDescription arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.getTermAnnotation +getTermAnnotation :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Maybe Core.Term) +getTermAnnotation arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getTermAnnotation")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.getTermDescription +getTermDescription :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error (Maybe String)) +getTermDescription arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getTermDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.getType +getType :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (Either Errors.DecodingError (Maybe Core.Type)) +getType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.getTypeAnnotation +getTypeAnnotation :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Maybe Core.Term) +getTypeAnnotation arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getTypeAnnotation")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.getTypeClasses +getTypeClasses :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error (M.Map Core.Name (S.Set Core.Name))) +getTypeClasses arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getTypeClasses")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.getTypeDescription +getTypeDescription :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either Errors.Error (Maybe String)) +getTypeDescription arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.getTypeDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.hasDescription +hasDescription :: Typed.TypedTerm (M.Map Core.Name t0) -> Typed.TypedTerm Bool +hasDescription arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.hasDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.hasTypeDescription +hasTypeDescription :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +hasTypeDescription arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.hasTypeDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.isNativeType +isNativeType :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Bool +isNativeType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.isNativeType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.normalizeTermAnnotations +normalizeTermAnnotations :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +normalizeTermAnnotations arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.normalizeTermAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.normalizeTypeAnnotations +normalizeTypeAnnotations :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +normalizeTypeAnnotations arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.normalizeTypeAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.setAnnotation +setAnnotation :: Ord t0 => (Typed.TypedTerm t0 -> Typed.TypedTerm (Maybe t1) -> Typed.TypedTerm (M.Map t0 t1) -> Typed.TypedTerm (M.Map t0 t1)) +setAnnotation arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setAnnotation")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.setDescription +setDescription :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (M.Map Core.Name Core.Term) +setDescription arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.setTermAnnotation +setTermAnnotation :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +setTermAnnotation arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setTermAnnotation")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.setTermDescription +setTermDescription :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +setTermDescription arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setTermDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.setType +setType :: Typed.TypedTerm (Maybe Core.Type) -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (M.Map Core.Name Core.Term) +setType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.setTypeAnnotation +setTypeAnnotation :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +setTypeAnnotation arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setTypeAnnotation")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.annotations.setTypeClasses +setTypeClasses :: Typed.TypedTerm (M.Map Core.Name (S.Set Core.Name)) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +setTypeClasses arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setTypeClasses")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.setTypeDescription +setTypeDescription :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +setTypeDescription arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.setTypeDescription")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.annotations.termAnnotationInternal +termAnnotationInternal :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (M.Map Core.Name Core.Term) +termAnnotationInternal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.termAnnotationInternal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.typeAnnotationInternal +typeAnnotationInternal :: Typed.TypedTerm Core.Type -> Typed.TypedTerm (M.Map Core.Name Core.Term) +typeAnnotationInternal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.typeAnnotationInternal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.annotations.wrapAnnotationMap +wrapAnnotationMap :: Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm Core.Term +wrapAnnotationMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.annotations.wrapAnnotationMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Arity.hs b/src/main/haskell/Hydra/Dsl/Arity.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Arity.hs @@ -0,0 +1,101 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.arity + +module Hydra.Dsl.Arity where + +import qualified Hydra.Arity as Arity +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.arity.primitiveArity +primitiveArity :: Typed.TypedTerm Graph.Primitive -> Typed.TypedTerm Int +primitiveArity arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.arity.primitiveArity")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.arity.termArity +termArity :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Int +termArity arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.arity.termArity")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.arity.typeArity +typeArity :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Int +typeArity arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.arity.typeArity")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.arity.typeSchemeArity +typeSchemeArity :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Int +typeSchemeArity arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.arity.typeSchemeArity")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.arity.uncurryType +uncurryType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm [Core.Type] +uncurryType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.arity.uncurryType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Ast.hs b/src/main/haskell/Hydra/Dsl/Ast.hs --- a/src/main/haskell/Hydra/Dsl/Ast.hs +++ b/src/main/haskell/Hydra/Dsl/Ast.hs @@ -6,11 +6,17 @@ import qualified Hydra.Ast as Ast import qualified Hydra.Core as Core +import qualified Hydra.Decode.Ast as DecodeAst import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Ast as EncodeAst import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +-- | DSL name token for hydra.ast.Associativity +associativityAssociativity :: Typed.TypedName Ast.Associativity +associativityAssociativity = Typed.TypedName (Core.Name "hydra.ast.Associativity") + -- | DSL injection for the both variant of hydra.ast.Associativity associativityBoth :: Typed.TypedTerm Ast.Associativity associativityBoth = @@ -63,6 +69,10 @@ Core.fieldName = (Core.Name "newlineAfterContent"), Core.fieldTerm = (Typed.unTypedTerm newlineAfterContent)}]})) +-- | DSL name token for hydra.ast.BlockStyle +blockStyleBlockStyle :: Typed.TypedName Ast.BlockStyle +blockStyleBlockStyle = Typed.TypedName (Core.Name "hydra.ast.BlockStyle") + -- | DSL accessor for the indent field of hydra.ast.BlockStyle blockStyleIndent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm (Maybe String) blockStyleIndent x = @@ -178,6 +188,10 @@ Core.fieldName = (Core.Name "style"), Core.fieldTerm = (Typed.unTypedTerm style)}]})) +-- | DSL name token for hydra.ast.BracketExpr +bracketExprBracketExpr :: Typed.TypedName Ast.BracketExpr +bracketExprBracketExpr = Typed.TypedName (Core.Name "hydra.ast.BracketExpr") + -- | DSL accessor for the brackets field of hydra.ast.BracketExpr bracketExprBrackets :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Brackets bracketExprBrackets x = @@ -290,6 +304,10 @@ Core.fieldName = (Core.Name "close"), Core.fieldTerm = (Typed.unTypedTerm close)}]})) +-- | DSL name token for hydra.ast.Brackets +bracketsBrackets :: Typed.TypedName Ast.Brackets +bracketsBrackets = Typed.TypedName (Core.Name "hydra.ast.Brackets") + -- | DSL accessor for the close field of hydra.ast.Brackets bracketsClose :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Symbol bracketsClose x = @@ -360,6 +378,10 @@ Core.fieldName = (Core.Name "const"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.ast.Expr +exprExpr :: Typed.TypedName Ast.Expr +exprExpr = Typed.TypedName (Core.Name "hydra.ast.Expr") + -- | DSL injection for the indent variant of hydra.ast.Expr exprIndent :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.Expr exprIndent x = @@ -396,6 +418,10 @@ Core.fieldName = (Core.Name "allLines"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.ast.IndentStyle +indentStyleIndentStyle :: Typed.TypedName Ast.IndentStyle +indentStyleIndentStyle = Typed.TypedName (Core.Name "hydra.ast.IndentStyle") + -- | DSL injection for the subsequentLines variant of hydra.ast.IndentStyle indentStyleSubsequentLines :: Typed.TypedTerm String -> Typed.TypedTerm Ast.IndentStyle indentStyleSubsequentLines x = @@ -427,6 +453,10 @@ Core.projectionFieldName = (Core.Name "expr")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.IndentedExpression +indentedExpressionIndentedExpression :: Typed.TypedName Ast.IndentedExpression +indentedExpressionIndentedExpression = Typed.TypedName (Core.Name "hydra.ast.IndentedExpression") + -- | DSL accessor for the style field of hydra.ast.IndentedExpression indentedExpressionStyle :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.IndentStyle indentedExpressionStyle x = @@ -532,6 +562,10 @@ Core.projectionFieldName = (Core.Name "op")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.OpExpr +opExprOpExpr :: Typed.TypedName Ast.OpExpr +opExprOpExpr = Typed.TypedName (Core.Name "hydra.ast.OpExpr") + -- | DSL accessor for the rhs field of hydra.ast.OpExpr opExprRhs :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr opExprRhs x = @@ -613,6 +647,10 @@ Core.fieldName = (Core.Name "rhs"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL name token for hydra.ast.Op +opOp :: Typed.TypedName Ast.Op +opOp = Typed.TypedName (Core.Name "hydra.ast.Op") + -- | DSL accessor for the padding field of hydra.ast.Op opPadding :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Padding opPadding x = @@ -786,6 +824,10 @@ Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.Padding +paddingPadding :: Typed.TypedName Ast.Padding +paddingPadding = Typed.TypedName (Core.Name "hydra.ast.Padding") + -- | DSL accessor for the right field of hydra.ast.Padding paddingRight :: Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Ws paddingRight x = @@ -836,6 +878,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.ast.Precedence"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.Precedence +precedencePrecedence :: Typed.TypedName Ast.Precedence +precedencePrecedence = Typed.TypedName (Core.Name "hydra.ast.Precedence") + -- | DSL constructor for hydra.ast.SeqExpr seqExpr :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.SeqExpr seqExpr op elements = @@ -867,6 +913,10 @@ Core.projectionFieldName = (Core.Name "op")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.SeqExpr +seqExprSeqExpr :: Typed.TypedName Ast.SeqExpr +seqExprSeqExpr = Typed.TypedName (Core.Name "hydra.ast.SeqExpr") + -- | DSL updater for the elements field of hydra.ast.SeqExpr seqExprWithElements :: Typed.TypedTerm Ast.SeqExpr -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.SeqExpr seqExprWithElements original newVal = @@ -908,6 +958,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.ast.Symbol"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.ast.Symbol +symbolSymbol :: Typed.TypedName Ast.Symbol +symbolSymbol = Typed.TypedName (Core.Name "hydra.ast.Symbol") + -- | DSL accessor for the body of hydra.ast.Precedence unPrecedence :: Typed.TypedTerm Ast.Precedence -> Typed.TypedTerm Int unPrecedence x = @@ -966,3 +1020,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "space"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.ast.Ws +wsWs :: Typed.TypedName Ast.Ws +wsWs = Typed.TypedName (Core.Name "hydra.ast.Ws") diff --git a/src/main/haskell/Hydra/Dsl/Checking.hs b/src/main/haskell/Hydra/Dsl/Checking.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Checking.hs @@ -0,0 +1,511 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.checking + +module Hydra.Dsl.Checking where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Checking as Checking +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Dependencies as Dependencies +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Dependencies as DslDependencies +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as DslErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Formatting as DslFormatting +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Resolution as DslResolution +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as ErrorChecking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +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.Lexical as Lexical +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Print.Variants as PrintVariants +import qualified Hydra.Query as Query +import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Resolution as Resolution +import qualified Hydra.Rewriting as Rewriting +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.checking.allEqual +allEqual :: Typed.TypedTerm [t0] -> Typed.TypedTerm Bool +allEqual arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.allEqual")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.checking.applyTypeArgumentsToType +applyTypeArgumentsToType :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either Errors.Error Core.Type) +applyTypeArgumentsToType arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.applyTypeArgumentsToType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.checkForUnboundTypeVariables +checkForUnboundTypeVariables :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error ()) +checkForUnboundTypeVariables arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.checkForUnboundTypeVariables")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.checking.checkSameType +checkSameType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm String -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Either Errors.Error Core.Type) +checkSameType arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.checkSameType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.checkTypeSubst +checkTypeSubst :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm (Either Errors.Error Typing.TypeSubst) +checkTypeSubst arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.checkTypeSubst")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.checking.containsInScopeTypeVars +containsInScopeTypeVars :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +containsInScopeTypeVars arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.containsInScopeTypeVars")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.checking.normalizeTypeFreeVars +normalizeTypeFreeVars :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +normalizeTypeFreeVars arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.normalizeTypeFreeVars")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.checking.toFContext +toFContext :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Type) +toFContext arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.toFContext")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.checking.typeListsEffectivelyEqual +typeListsEffectivelyEqual :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Bool +typeListsEffectivelyEqual arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeListsEffectivelyEqual")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.checking.typeOf +typeOf :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOf arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOf")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfAnnotatedTerm +typeOfAnnotatedTerm :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfAnnotatedTerm arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfAnnotatedTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfApplication +typeOfApplication :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Application -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfApplication arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfApplication")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfCaseStatement +typeOfCaseStatement :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfCaseStatement arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfCaseStatement")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfEither +typeOfEither :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Either Core.Term Core.Term) -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfEither arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfEither")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfInjection +typeOfInjection :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Injection -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfInjection arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfInjection")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfLambda +typeOfLambda :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Lambda -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfLambda arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfLambda")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfLet +typeOfLet :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Let -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfLet arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfLet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfList +typeOfList :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm [Core.Term] -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfList arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfLiteral +typeOfLiteral :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Literal -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfLiteral arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfLiteral")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfMap +typeOfMap :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (M.Map Core.Term Core.Term) -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfMap arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfMaybe +typeOfMaybe :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfMaybe arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfMaybe")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfPair +typeOfPair :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Core.Term, Core.Term) -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfPair arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfPair")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfPrimitive +typeOfPrimitive :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfPrimitive arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfPrimitive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfProjection +typeOfProjection :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Projection -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfProjection arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfProjection")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfRecord +typeOfRecord :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Record -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfRecord arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfRecord")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfSet +typeOfSet :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (S.Set Core.Term) -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfSet arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfSet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfTerm +typeOfTerm :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error Core.Type) +typeOfTerm arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.checking.typeOfTypeApplication +typeOfTypeApplication :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfTypeApplication arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfTypeApplication")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfTypeLambda +typeOfTypeLambda :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfTypeLambda arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfTypeLambda")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfUnit +typeOfUnit :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfUnit arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfUnit")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.checking.typeOfUnwrap +typeOfUnwrap :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfUnwrap arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfUnwrap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfVariable +typeOfVariable :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfVariable arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typeOfWrappedTerm +typeOfWrappedTerm :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm (Either Errors.Error (Core.Type, Typing.InferenceContext)) +typeOfWrappedTerm arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typeOfWrappedTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.checking.typesAllEffectivelyEqual +typesAllEffectivelyEqual :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Bool +typesAllEffectivelyEqual arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typesAllEffectivelyEqual")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.checking.typesEffectivelyEqual +typesEffectivelyEqual :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +typesEffectivelyEqual arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.checking.typesEffectivelyEqual")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) diff --git a/src/main/haskell/Hydra/Dsl/Coders.hs b/src/main/haskell/Hydra/Dsl/Coders.hs --- a/src/main/haskell/Hydra/Dsl/Coders.hs +++ b/src/main/haskell/Hydra/Dsl/Coders.hs @@ -6,12 +6,14 @@ import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core +import qualified Hydra.Decode.Coders as DecodeCoders import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Errors as DslErrors import qualified Hydra.Dsl.File as DslFile import qualified Hydra.Dsl.Graph as DslGraph import qualified Hydra.Dsl.Util as DslUtil import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Coders as EncodeCoders import qualified Hydra.Errors as Errors import qualified Hydra.File as File import qualified Hydra.Graph as Graph @@ -42,6 +44,10 @@ Core.fieldName = (Core.Name "coder"), Core.fieldTerm = (Typed.unTypedTerm coder)}]})) +-- | DSL name token for hydra.coders.Adapter +adapterAdapter :: Typed.TypedName (Coders.Adapter t1 t2 v1 v2 e) +adapterAdapter = Typed.TypedName (Core.Name "hydra.coders.Adapter") + -- | DSL accessor for the coder field of hydra.coders.Adapter adapterCoder :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm (Coders.Coder v1 v2 e) adapterCoder x = @@ -67,6 +73,10 @@ Core.fieldName = (Core.Name "adapters"), Core.fieldTerm = (Typed.unTypedTerm adapters)}]})) +-- | DSL name token for hydra.coders.AdapterContext +adapterContextAdapterContext :: Typed.TypedName Coders.AdapterContext +adapterContextAdapterContext = Typed.TypedName (Core.Name "hydra.coders.AdapterContext") + -- | DSL accessor for the adapters field of hydra.coders.AdapterContext adapterContextAdapters :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm (M.Map Core.Name (Coders.Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error)) adapterContextAdapters x = @@ -330,6 +340,10 @@ Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) +-- | DSL name token for hydra.coders.Bicoder +bicoderBicoder :: Typed.TypedName (Coders.Bicoder t1 t2 v1 v2 e) +bicoderBicoder = Typed.TypedName (Core.Name "hydra.coders.Bicoder") + -- | DSL accessor for the decode field of hydra.coders.Bicoder bicoderDecode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1 e) bicoderDecode x = @@ -419,6 +433,10 @@ Core.fieldName = (Core.Name "typeVariable"), Core.fieldTerm = (Typed.unTypedTerm typeVariable)}]})) +-- | DSL name token for hydra.coders.CaseConventions +caseConventionsCaseConventions :: Typed.TypedName Coders.CaseConventions +caseConventionsCaseConventions = Typed.TypedName (Core.Name "hydra.coders.CaseConventions") + -- | DSL accessor for the constant field of hydra.coders.CaseConventions caseConventionsConstant :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsConstant x = @@ -1252,6 +1270,10 @@ Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) +-- | DSL name token for hydra.coders.Coder +coderCoder :: Typed.TypedName (Coders.Coder v1 v2 e) +coderCoder = Typed.TypedName (Core.Name "hydra.coders.Coder") + -- | DSL accessor for the decode field of hydra.coders.Coder coderDecode :: Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (v2 -> Either e v1) coderDecode x = @@ -1261,6 +1283,10 @@ Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.coders.CoderDirection +coderDirectionCoderDirection :: Typed.TypedName Coders.CoderDirection +coderDirectionCoderDirection = Typed.TypedName (Core.Name "hydra.coders.CoderDirection") + -- | DSL injection for the decode variant of hydra.coders.CoderDirection coderDirectionDecode :: Typed.TypedTerm Coders.CoderDirection coderDirectionDecode = @@ -1322,6 +1348,88 @@ Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) +-- | DSL composition builder for the decoder of hydra.coders.Adapter +decodeAdapter :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t1) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t2) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v1) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v2) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError e) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Coders.Adapter t1 t2 v1 v2 e)) +decodeAdapter t1 t2 v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.coders.adapter")), + Core.applicationArgument = (Typed.unTypedTerm t1)})), + Core.applicationArgument = (Typed.unTypedTerm t2)})), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the decoder of hydra.coders.Bicoder +decodeBicoder :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t1) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t2) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v1) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v2) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError e) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Coders.Bicoder t1 t2 v1 v2 e)) +decodeBicoder t1 t2 v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.coders.bicoder")), + Core.applicationArgument = (Typed.unTypedTerm t1)})), + Core.applicationArgument = (Typed.unTypedTerm t2)})), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the decoder of hydra.coders.Coder +decodeCoder :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v1) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v2) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError e) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Coders.Coder v1 v2 e)) +decodeCoder v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.coders.coder")), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the encoder of hydra.coders.Adapter +encodeAdapter :: Typed.TypedTerm (t1 -> Core.Term) -> Typed.TypedTerm (t2 -> Core.Term) -> Typed.TypedTerm (v1 -> Core.Term) -> Typed.TypedTerm (v2 -> Core.Term) -> Typed.TypedTerm (e -> Core.Term) -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e -> Core.Term) +encodeAdapter t1 t2 v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.coders.adapter")), + Core.applicationArgument = (Typed.unTypedTerm t1)})), + Core.applicationArgument = (Typed.unTypedTerm t2)})), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the encoder of hydra.coders.Bicoder +encodeBicoder :: Typed.TypedTerm (t1 -> Core.Term) -> Typed.TypedTerm (t2 -> Core.Term) -> Typed.TypedTerm (v1 -> Core.Term) -> Typed.TypedTerm (v2 -> Core.Term) -> Typed.TypedTerm (e -> Core.Term) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e -> Core.Term) +encodeBicoder t1 t2 v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.coders.bicoder")), + Core.applicationArgument = (Typed.unTypedTerm t1)})), + Core.applicationArgument = (Typed.unTypedTerm t2)})), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the encoder of hydra.coders.Coder +encodeCoder :: Typed.TypedTerm (v1 -> Core.Term) -> Typed.TypedTerm (v2 -> Core.Term) -> Typed.TypedTerm (e -> Core.Term) -> Typed.TypedTerm (Coders.Coder v1 v2 e -> Core.Term) +encodeCoder v1 v2 e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.coders.coder")), + Core.applicationArgument = (Typed.unTypedTerm v1)})), + Core.applicationArgument = (Typed.unTypedTerm v2)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) + -- | DSL constructor for hydra.coders.Language language :: Typed.TypedTerm Coders.LanguageName -> Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Coders.LanguageFeature) -> Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm File.FileExtension -> Typed.TypedTerm Coders.Language language name constraints supportedFeatures caseConventions defaultFileExtension = @@ -1405,6 +1513,10 @@ Core.projectionFieldName = (Core.Name "integerTypes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.coders.LanguageConstraints +languageConstraintsLanguageConstraints :: Typed.TypedName Coders.LanguageConstraints +languageConstraintsLanguageConstraints = Typed.TypedName (Core.Name "hydra.coders.LanguageConstraints") + -- | DSL accessor for the literalVariants field of hydra.coders.LanguageConstraints languageConstraintsLiteralVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.LiteralVariant) languageConstraintsLiteralVariants x = @@ -1720,6 +1832,10 @@ Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.coders.LanguageFeature +languageFeatureLanguageFeature :: Typed.TypedName Coders.LanguageFeature +languageFeatureLanguageFeature = Typed.TypedName (Core.Name "hydra.coders.LanguageFeature") + -- | DSL injection for the nestedCaseStatements variant of hydra.coders.LanguageFeature languageFeatureNestedCaseStatements :: Typed.TypedTerm Coders.LanguageFeature languageFeatureNestedCaseStatements = @@ -1747,6 +1863,10 @@ Core.fieldName = (Core.Name "partialApplication"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.coders.Language +languageLanguage :: Typed.TypedName Coders.Language +languageLanguage = Typed.TypedName (Core.Name "hydra.coders.Language") + -- | DSL accessor for the name field of hydra.coders.Language languageName :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.LanguageName languageName x = @@ -1763,6 +1883,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.coders.LanguageName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.coders.LanguageName +languageNameLanguageName :: Typed.TypedName Coders.LanguageName +languageNameLanguageName = Typed.TypedName (Core.Name "hydra.coders.LanguageName") + -- | DSL accessor for the supportedFeatures field of hydra.coders.Language languageSupportedFeatures :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm (S.Set Coders.LanguageFeature) languageSupportedFeatures x = @@ -1979,6 +2103,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pre"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.coders.TraversalOrder +traversalOrderTraversalOrder :: Typed.TypedName Coders.TraversalOrder +traversalOrderTraversalOrder = Typed.TypedName (Core.Name "hydra.coders.TraversalOrder") -- | DSL accessor for the body of hydra.coders.LanguageName unLanguageName :: Typed.TypedTerm Coders.LanguageName -> Typed.TypedTerm String diff --git a/src/main/haskell/Hydra/Dsl/Constants.hs b/src/main/haskell/Hydra/Dsl/Constants.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Constants.hs @@ -0,0 +1,142 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.constants + +module Hydra.Dsl.Constants where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.constants.ignoredVariable +ignoredVariable :: Typed.TypedTerm String +ignoredVariable = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.ignoredVariable")) + +-- | DSL reference to hydra.constants.keyClasses +keyClasses :: Typed.TypedTerm Core.Name +keyClasses = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyClasses")) + +-- | DSL reference to hydra.constants.keyDebugId +keyDebugId :: Typed.TypedTerm Core.Name +keyDebugId = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyDebugId")) + +-- | DSL reference to hydra.constants.keyDeprecated +keyDeprecated :: Typed.TypedTerm Core.Name +keyDeprecated = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyDeprecated")) + +-- | DSL reference to hydra.constants.keyDescription +keyDescription :: Typed.TypedTerm Core.Name +keyDescription = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyDescription")) + +-- | DSL reference to hydra.constants.keyExclude +keyExclude :: Typed.TypedTerm Core.Name +keyExclude = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyExclude")) + +-- | DSL reference to hydra.constants.keyFirstClassType +keyFirstClassType :: Typed.TypedTerm Core.Name +keyFirstClassType = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyFirstClassType")) + +-- | DSL reference to hydra.constants.keyFreshTypeVariableCount +keyFreshTypeVariableCount :: Typed.TypedTerm Core.Name +keyFreshTypeVariableCount = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyFreshTypeVariableCount")) + +-- | DSL reference to hydra.constants.keyMaxLength +keyMaxLength :: Typed.TypedTerm Core.Name +keyMaxLength = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyMaxLength")) + +-- | DSL reference to hydra.constants.keyMinLength +keyMinLength :: Typed.TypedTerm Core.Name +keyMinLength = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyMinLength")) + +-- | DSL reference to hydra.constants.keyPreserveFieldName +keyPreserveFieldName :: Typed.TypedTerm Core.Name +keyPreserveFieldName = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyPreserveFieldName")) + +-- | DSL reference to hydra.constants.keyType +keyType :: Typed.TypedTerm Core.Name +keyType = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.keyType")) + +-- | DSL reference to hydra.constants.maxInt32 +maxInt32 :: Typed.TypedTerm Int +maxInt32 = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.maxInt32")) + +-- | DSL reference to hydra.constants.maxTraceDepth +maxTraceDepth :: Typed.TypedTerm Int +maxTraceDepth = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.maxTraceDepth")) + +-- | DSL reference to hydra.constants.regexCamelCase +regexCamelCase :: Typed.TypedTerm String +regexCamelCase = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.regexCamelCase")) + +-- | DSL reference to hydra.constants.regexNamespace +regexNamespace :: Typed.TypedTerm String +regexNamespace = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.regexNamespace")) + +-- | DSL reference to hydra.constants.regexPackageName +regexPackageName :: Typed.TypedTerm String +regexPackageName = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.regexPackageName")) + +-- | DSL reference to hydra.constants.regexPascalCase +regexPascalCase :: Typed.TypedTerm String +regexPascalCase = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.regexPascalCase")) + +-- | DSL reference to hydra.constants.warningAutoGeneratedFile +warningAutoGeneratedFile :: Typed.TypedTerm String +warningAutoGeneratedFile = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.constants.warningAutoGeneratedFile")) diff --git a/src/main/haskell/Hydra/Dsl/Core.hs b/src/main/haskell/Hydra/Dsl/Core.hs --- a/src/main/haskell/Hydra/Dsl/Core.hs +++ b/src/main/haskell/Hydra/Dsl/Core.hs @@ -5,6 +5,8 @@ module Hydra.Dsl.Core where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci @@ -26,6 +28,10 @@ Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm annotation)}]})) +-- | DSL name token for hydra.core.AnnotatedTerm +annotatedTermAnnotatedTerm :: Typed.TypedName Core.AnnotatedTerm +annotatedTermAnnotatedTerm = Typed.TypedName (Core.Name "hydra.core.AnnotatedTerm") + -- | DSL accessor for the annotation field of hydra.core.AnnotatedTerm annotatedTermAnnotation :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term annotatedTermAnnotation x = @@ -91,6 +97,10 @@ Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm annotation)}]})) +-- | DSL name token for hydra.core.AnnotatedType +annotatedTypeAnnotatedType :: Typed.TypedName Core.AnnotatedType +annotatedTypeAnnotatedType = Typed.TypedName (Core.Name "hydra.core.AnnotatedType") + -- | DSL accessor for the annotation field of hydra.core.AnnotatedType annotatedTypeAnnotation :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Term annotatedTypeAnnotation x = @@ -156,6 +166,10 @@ Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm argument)}]})) +-- | DSL name token for hydra.core.Application +applicationApplication :: Typed.TypedName Core.Application +applicationApplication = Typed.TypedName (Core.Name "hydra.core.Application") + -- | DSL accessor for the argument field of hydra.core.Application applicationArgument :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term applicationArgument x = @@ -187,6 +201,10 @@ Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm argument)}]})) +-- | DSL name token for hydra.core.ApplicationType +applicationTypeApplicationType :: Typed.TypedName Core.ApplicationType +applicationTypeApplicationType = Typed.TypedName (Core.Name "hydra.core.ApplicationType") + -- | DSL accessor for the argument field of hydra.core.ApplicationType applicationTypeArgument :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type applicationTypeArgument x = @@ -289,6 +307,10 @@ Core.fieldName = (Core.Name "typeScheme"), Core.fieldTerm = (Typed.unTypedTerm typeScheme)}]})) +-- | DSL name token for hydra.core.Binding +bindingBinding :: Typed.TypedName Core.Binding +bindingBinding = Typed.TypedName (Core.Name "hydra.core.Binding") + -- | DSL accessor for the name field of hydra.core.Binding bindingName :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Core.Name bindingName x = @@ -401,6 +423,10 @@ Core.fieldName = (Core.Name "handler"), Core.fieldTerm = (Typed.unTypedTerm handler)}]})) +-- | DSL name token for hydra.core.CaseAlternative +caseAlternativeCaseAlternative :: Typed.TypedName Core.CaseAlternative +caseAlternativeCaseAlternative = Typed.TypedName (Core.Name "hydra.core.CaseAlternative") + -- | DSL accessor for the handler field of hydra.core.CaseAlternative caseAlternativeHandler :: Typed.TypedTerm Core.CaseAlternative -> Typed.TypedTerm Core.Term caseAlternativeHandler x = @@ -469,6 +495,10 @@ Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm cases)}]})) +-- | DSL name token for hydra.core.CaseStatement +caseStatementCaseStatement :: Typed.TypedName Core.CaseStatement +caseStatementCaseStatement = Typed.TypedName (Core.Name "hydra.core.CaseStatement") + -- | DSL accessor for the cases field of hydra.core.CaseStatement caseStatementCases :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm [Core.CaseAlternative] caseStatementCases x = @@ -581,6 +611,10 @@ Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm right)}]})) +-- | DSL name token for hydra.core.EitherType +eitherTypeEitherType :: Typed.TypedName Core.EitherType +eitherTypeEitherType = Typed.TypedName (Core.Name "hydra.core.EitherType") + -- | DSL accessor for the left field of hydra.core.EitherType eitherTypeLeft :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type eitherTypeLeft x = @@ -646,6 +680,10 @@ Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm term)}]})) +-- | DSL name token for hydra.core.Field +fieldField :: Typed.TypedName Core.Field +fieldField = Typed.TypedName (Core.Name "hydra.core.Field") + -- | DSL accessor for the name field of hydra.core.Field fieldName :: Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Name fieldName x = @@ -677,6 +715,10 @@ Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) +-- | DSL name token for hydra.core.FieldType +fieldTypeFieldType :: Typed.TypedName Core.FieldType +fieldTypeFieldType = Typed.TypedName (Core.Name "hydra.core.FieldType") + -- | DSL accessor for the name field of hydra.core.FieldType fieldTypeName :: Typed.TypedTerm Core.FieldType -> Typed.TypedTerm Core.Name fieldTypeName x = @@ -781,6 +823,10 @@ Core.fieldName = (Core.Name "float64"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.core.FloatType +floatTypeFloatType :: Typed.TypedName Core.FloatType +floatTypeFloatType = Typed.TypedName (Core.Name "hydra.core.FloatType") + -- | DSL injection for the float32 variant of hydra.core.FloatValue floatValueFloat32 :: Typed.TypedTerm Float -> Typed.TypedTerm Core.FloatValue floatValueFloat32 x = @@ -799,6 +845,10 @@ Core.fieldName = (Core.Name "float64"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.FloatValue +floatValueFloatValue :: Typed.TypedName Core.FloatValue +floatValueFloatValue = Typed.TypedName (Core.Name "hydra.core.FloatValue") + -- | DSL constructor for hydra.core.ForallType forallType :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ForallType forallType parameter body = @@ -821,6 +871,10 @@ Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.ForallType +forallTypeForallType :: Typed.TypedName Core.ForallType +forallTypeForallType = Typed.TypedName (Core.Name "hydra.core.ForallType") + -- | DSL accessor for the parameter field of hydra.core.ForallType forallTypeParameter :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Name forallTypeParameter x = @@ -895,6 +949,10 @@ Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.FunctionType +functionTypeFunctionType :: Typed.TypedName Core.FunctionType +functionTypeFunctionType = Typed.TypedName (Core.Name "hydra.core.FunctionType") + -- | DSL updater for the codomain field of hydra.core.FunctionType functionTypeWithCodomain :: Typed.TypedTerm Core.FunctionType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.FunctionType functionTypeWithCodomain original newVal = @@ -951,6 +1009,10 @@ Core.projectionFieldName = (Core.Name "field")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Injection +injectionInjection :: Typed.TypedName Core.Injection +injectionInjection = Typed.TypedName (Core.Name "hydra.core.Injection") + -- | DSL accessor for the typeName field of hydra.core.Injection injectionTypeName :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Name injectionTypeName x = @@ -1039,6 +1101,10 @@ Core.fieldName = (Core.Name "int8"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.core.IntegerType +integerTypeIntegerType :: Typed.TypedName Core.IntegerType +integerTypeIntegerType = Typed.TypedName (Core.Name "hydra.core.IntegerType") + -- | DSL injection for the uint16 variant of hydra.core.IntegerType integerTypeUint16 :: Typed.TypedTerm Core.IntegerType integerTypeUint16 = @@ -1120,6 +1186,10 @@ Core.fieldName = (Core.Name "int8"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.IntegerValue +integerValueIntegerValue :: Typed.TypedName Core.IntegerValue +integerValueIntegerValue = Typed.TypedName (Core.Name "hydra.core.IntegerValue") + -- | DSL injection for the uint16 variant of hydra.core.IntegerValue integerValueUint16 :: Typed.TypedTerm Int -> Typed.TypedTerm Core.IntegerValue integerValueUint16 x = @@ -1190,6 +1260,10 @@ Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Lambda +lambdaLambda :: Typed.TypedName Core.Lambda +lambdaLambda = Typed.TypedName (Core.Name "hydra.core.Lambda") + -- | DSL accessor for the parameter field of hydra.core.Lambda lambdaParameter :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Name lambdaParameter x = @@ -1302,6 +1376,10 @@ Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Let +letLet :: Typed.TypedName Core.Let +letLet = Typed.TypedName (Core.Name "hydra.core.Let") + -- | DSL updater for the bindings field of hydra.core.Let letWithBindings :: Typed.TypedTerm Core.Let -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Core.Let letWithBindings original newVal = @@ -1381,6 +1459,10 @@ Core.fieldName = (Core.Name "integer"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.Literal +literalLiteral :: Typed.TypedName Core.Literal +literalLiteral = Typed.TypedName (Core.Name "hydra.core.Literal") + -- | DSL injection for the string variant of hydra.core.Literal literalString :: Typed.TypedTerm String -> Typed.TypedTerm Core.Literal literalString x = @@ -1435,6 +1517,10 @@ Core.fieldName = (Core.Name "integer"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.LiteralType +literalTypeLiteralType :: Typed.TypedName Core.LiteralType +literalTypeLiteralType = Typed.TypedName (Core.Name "hydra.core.LiteralType") + -- | DSL injection for the string variant of hydra.core.LiteralType literalTypeString :: Typed.TypedTerm Core.LiteralType literalTypeString = @@ -1466,6 +1552,10 @@ Core.projectionFieldName = (Core.Name "keys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.MapType +mapTypeMapType :: Typed.TypedName Core.MapType +mapTypeMapType = Typed.TypedName (Core.Name "hydra.core.MapType") + -- | DSL accessor for the values field of hydra.core.MapType mapTypeValues :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type mapTypeValues x = @@ -1516,6 +1606,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Name +nameName :: Typed.TypedName Core.Name +nameName = Typed.TypedName (Core.Name "hydra.core.Name") + -- | DSL constructor for hydra.core.PairType pairType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.PairType pairType first second = @@ -1538,6 +1632,10 @@ Core.projectionFieldName = (Core.Name "first")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.PairType +pairTypePairType :: Typed.TypedName Core.PairType +pairTypePairType = Typed.TypedName (Core.Name "hydra.core.PairType") + -- | DSL accessor for the second field of hydra.core.PairType pairTypeSecond :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type pairTypeSecond x = @@ -1603,6 +1701,10 @@ Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Projection +projectionProjection :: Typed.TypedName Core.Projection +projectionProjection = Typed.TypedName (Core.Name "hydra.core.Projection") + -- | DSL accessor for the typeName field of hydra.core.Projection projectionTypeName :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Name projectionTypeName x = @@ -1668,6 +1770,10 @@ Core.projectionFieldName = (Core.Name "fields")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.Record +recordRecord :: Typed.TypedName Core.Record +recordRecord = Typed.TypedName (Core.Name "hydra.core.Record") + -- | DSL accessor for the typeName field of hydra.core.Record recordTypeName :: Typed.TypedTerm Core.Record -> Typed.TypedTerm Core.Name recordTypeName x = @@ -1846,6 +1952,10 @@ Core.fieldName = (Core.Name "set"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.Term +termTerm :: Typed.TypedName Core.Term +termTerm = Typed.TypedName (Core.Name "hydra.core.Term") + -- | DSL injection for the typeApplication variant of hydra.core.Term termTypeApplication :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Term termTypeApplication x = @@ -1949,6 +2059,10 @@ Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.TypeApplicationTerm +typeApplicationTermTypeApplicationTerm :: Typed.TypedName Core.TypeApplicationTerm +typeApplicationTermTypeApplicationTerm = Typed.TypedName (Core.Name "hydra.core.TypeApplicationTerm") + -- | DSL updater for the body field of hydra.core.TypeApplicationTerm typeApplicationTermWithBody :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.TypeApplicationTerm typeApplicationTermWithBody original newVal = @@ -1992,6 +2106,10 @@ Core.fieldName = (Core.Name "simple"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.TypeClassConstraint +typeClassConstraintTypeClassConstraint :: Typed.TypedName Core.TypeClassConstraint +typeClassConstraintTypeClassConstraint = Typed.TypedName (Core.Name "hydra.core.TypeClassConstraint") + -- | DSL injection for the effect variant of hydra.core.Type typeEffect :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type typeEffect x = @@ -2059,6 +2177,10 @@ Core.projectionFieldName = (Core.Name "parameter")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.TypeLambda +typeLambdaTypeLambda :: Typed.TypedName Core.TypeLambda +typeLambdaTypeLambda = Typed.TypedName (Core.Name "hydra.core.TypeLambda") + -- | DSL updater for the body field of hydra.core.TypeLambda typeLambdaWithBody :: Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.TypeLambda typeLambdaWithBody original newVal = @@ -2181,6 +2303,10 @@ Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.TypeScheme +typeSchemeTypeScheme :: Typed.TypedName Core.TypeScheme +typeSchemeTypeScheme = Typed.TypedName (Core.Name "hydra.core.TypeScheme") + -- | DSL accessor for the variables field of hydra.core.TypeScheme typeSchemeVariables :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm [Core.Name] typeSchemeVariables x = @@ -2271,6 +2397,10 @@ Core.fieldName = (Core.Name "set"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.core.Type +typeType :: Typed.TypedName Core.Type +typeType = Typed.TypedName (Core.Name "hydra.core.Type") + -- | DSL injection for the union variant of hydra.core.Type typeUnion :: Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm Core.Type typeUnion x = @@ -2317,6 +2447,10 @@ Core.projectionFieldName = (Core.Name "classes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.core.TypeVariableConstraints +typeVariableConstraintsTypeVariableConstraints :: Typed.TypedName Core.TypeVariableConstraints +typeVariableConstraintsTypeVariableConstraints = Typed.TypedName (Core.Name "hydra.core.TypeVariableConstraints") + -- | DSL updater for the classes field of hydra.core.TypeVariableConstraints typeVariableConstraintsWithClasses :: Typed.TypedTerm Core.TypeVariableConstraints -> Typed.TypedTerm [Core.TypeClassConstraint] -> Typed.TypedTerm Core.TypeVariableConstraints typeVariableConstraintsWithClasses original newVal = @@ -2416,3 +2550,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.WrappedTerm"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL name token for hydra.core.WrappedTerm +wrappedTermWrappedTerm :: Typed.TypedName Core.WrappedTerm +wrappedTermWrappedTerm = Typed.TypedName (Core.Name "hydra.core.WrappedTerm") diff --git a/src/main/haskell/Hydra/Dsl/Dependencies.hs b/src/main/haskell/Hydra/Dsl/Dependencies.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Dependencies.hs @@ -0,0 +1,205 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.dependencies + +module Hydra.Dsl.Dependencies where + +import qualified Hydra.Annotations as Annotations +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Dependencies as Dependencies +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Annotations as DslAnnotations +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.Sorting as DslSorting +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +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.Sorting as Sorting +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.dependencies.definitionsWithDependencies +definitionsWithDependencies :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (Either Errors.Error [Core.Binding]) +definitionsWithDependencies arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.definitionsWithDependencies")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.dependencies.flattenLetTerms +flattenLetTerms :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +flattenLetTerms arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.flattenLetTerms")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.inlineType +inlineType :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either Errors.Error Core.Type) +inlineType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.inlineType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.dependencies.isLambda +isLambda :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isLambda arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.isLambda")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.liftLambdaAboveLet +liftLambdaAboveLet :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +liftLambdaAboveLet arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.liftLambdaAboveLet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.pruneLet +pruneLet :: Typed.TypedTerm Core.Let -> Typed.TypedTerm Core.Let +pruneLet arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.pruneLet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.replaceTypedefs +replaceTypedefs :: Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +replaceTypedefs arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.replaceTypedefs")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.dependencies.simplifyTerm +simplifyTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +simplifyTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.simplifyTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.termDependencyNames +termDependencyNames :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (S.Set Core.Name) +termDependencyNames arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.termDependencyNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.dependencies.toShortNames +toShortNames :: Typed.TypedTerm [Core.Name] -> Typed.TypedTerm (M.Map Core.Name Core.Name) +toShortNames arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.toShortNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.topologicalSortBindingMap +topologicalSortBindingMap :: Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm [[(Core.Name, Core.Term)]] +topologicalSortBindingMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.topologicalSortBindingMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.topologicalSortBindings +topologicalSortBindings :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (Either [[Core.Name]] [Core.Name]) +topologicalSortBindings arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.topologicalSortBindings")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.topologicalSortTypeDefinitions +topologicalSortTypeDefinitions :: Typed.TypedTerm [Packaging.TypeDefinition] -> Typed.TypedTerm [[Packaging.TypeDefinition]] +topologicalSortTypeDefinitions arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.topologicalSortTypeDefinitions")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.dependencies.typeDependencyNames +typeDependencyNames :: Typed.TypedTerm Bool -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (S.Set Core.Name) +typeDependencyNames arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.typeDependencyNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.dependencies.typeNamesInType +typeNamesInType :: Ord t0 => (Typed.TypedTerm Core.Type -> Typed.TypedTerm (S.Set t0)) +typeNamesInType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.dependencies.typeNamesInType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Docs.hs b/src/main/haskell/Hydra/Dsl/Docs.hs --- a/src/main/haskell/Hydra/Dsl/Docs.hs +++ b/src/main/haskell/Hydra/Dsl/Docs.hs @@ -5,12 +5,18 @@ module Hydra.Dsl.Docs where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Docs as DecodeDocs import qualified Hydra.Docs as Docs import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Encode.Docs as EncodeDocs import qualified Hydra.Packaging as Packaging import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + +-- | DSL name token for hydra.docs.DocSegment +docSegmentDocSegment :: Typed.TypedName Docs.DocSegment +docSegmentDocSegment = Typed.TypedName (Core.Name "hydra.docs.DocSegment") -- | DSL injection for the ref variant of hydra.docs.DocSegment docSegmentRef :: Typed.TypedTerm Packaging.EntityReference -> Typed.TypedTerm Docs.DocSegment diff --git a/src/main/haskell/Hydra/Dsl/Environment.hs b/src/main/haskell/Hydra/Dsl/Environment.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Environment.hs @@ -0,0 +1,195 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.environment + +module Hydra.Dsl.Environment where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Sorting as DslSorting +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Environment as Environment +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Sorting as Sorting +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.environment.definitionAsTypeApplicationTerm +definitionAsTypeApplicationTerm :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm (Either Errors.Error Core.TypeApplicationTerm) +definitionAsTypeApplicationTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.definitionAsTypeApplicationTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.graphAsLet +graphAsLet :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Let +graphAsLet arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.graphAsLet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.environment.graphAsTerm +graphAsTerm :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +graphAsTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.graphAsTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.environment.graphAsTypes +graphAsTypes :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (Either Errors.DecodingError (M.Map Core.Name Core.Type)) +graphAsTypes arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.graphAsTypes")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.environment.partitionDefinitions +partitionDefinitions :: Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm ([Packaging.TypeDefinition], [Packaging.TermDefinition]) +partitionDefinitions arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.partitionDefinitions")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.reorderDefs +reorderDefs :: Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm [Packaging.Definition] +reorderDefs arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.reorderDefs")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.schemaGraphToTypingEnvironment +schemaGraphToTypingEnvironment :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (Either Errors.Error (M.Map Core.Name Core.TypeScheme)) +schemaGraphToTypingEnvironment arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.schemaGraphToTypingEnvironment")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.termAsBindings +termAsBindings :: Typed.TypedTerm Core.Term -> Typed.TypedTerm [Core.Binding] +termAsBindings arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.termAsBindings")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.typesToDefinitions +typesToDefinitions :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm [Core.Binding] +typesToDefinitions arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.typesToDefinitions")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.environment.withLambdaContext +withLambdaContext :: Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t1) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Lambda -> Typed.TypedTerm (t1 -> t2) -> Typed.TypedTerm t2 +withLambdaContext arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.withLambdaContext")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) + +-- | DSL reference to hydra.environment.withLetContext +withLetContext :: Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t1) -> Typed.TypedTerm (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Let -> Typed.TypedTerm (t1 -> t2) -> Typed.TypedTerm t2 +withLetContext arg0 arg1 arg2 arg3 arg4 arg5 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.withLetContext")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})), + Core.applicationArgument = (Typed.unTypedTerm arg5)})) + +-- | DSL reference to hydra.environment.withTypeLambdaContext +withTypeLambdaContext :: Typed.TypedTerm (t0 -> Graph.Graph) -> Typed.TypedTerm (Graph.Graph -> t0 -> t1) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm (t1 -> t2) -> Typed.TypedTerm t2 +withTypeLambdaContext arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.environment.withTypeLambdaContext")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) diff --git a/src/main/haskell/Hydra/Dsl/Error/Checking.hs b/src/main/haskell/Hydra/Dsl/Error/Checking.hs --- a/src/main/haskell/Hydra/Dsl/Error/Checking.hs +++ b/src/main/haskell/Hydra/Dsl/Error/Checking.hs @@ -5,10 +5,12 @@ module Hydra.Dsl.Error.Checking where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Error.Checking as DecodeErrorChecking import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Typing as DslTyping import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Error.Checking as EncodeErrorChecking import qualified Hydra.Error.Checking as Checking import qualified Hydra.Paths as Paths import qualified Hydra.Typed as Typed @@ -18,6 +20,10 @@ import qualified Data.Scientific as Sci import qualified Data.Set as S +-- | DSL name token for hydra.error.checking.CheckingError +checkingErrorCheckingError :: Typed.TypedName Checking.CheckingError +checkingErrorCheckingError = Typed.TypedName (Core.Name "hydra.error.checking.CheckingError") + -- | DSL injection for the incorrectUnification variant of hydra.error.checking.CheckingError checkingErrorIncorrectUnification :: Typed.TypedTerm Checking.IncorrectUnificationError -> Typed.TypedTerm Checking.CheckingError checkingErrorIncorrectUnification x = @@ -145,6 +151,11 @@ Core.fieldName = (Core.Name "substitution"), Core.fieldTerm = (Typed.unTypedTerm substitution)}]})) +-- | DSL name token for hydra.error.checking.IncorrectUnificationError +incorrectUnificationErrorIncorrectUnificationError :: Typed.TypedName Checking.IncorrectUnificationError +incorrectUnificationErrorIncorrectUnificationError = + Typed.TypedName (Core.Name "hydra.error.checking.IncorrectUnificationError") + -- | DSL accessor for the substitution field of hydra.error.checking.IncorrectUnificationError incorrectUnificationErrorSubstitution :: Typed.TypedTerm Checking.IncorrectUnificationError -> Typed.TypedTerm Typing.TypeSubst incorrectUnificationErrorSubstitution x = @@ -177,6 +188,10 @@ Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = (Typed.unTypedTerm typeArguments)}]})) +-- | DSL name token for hydra.error.checking.NotAForallTypeError +notAForallTypeErrorNotAForallTypeError :: Typed.TypedName Checking.NotAForallTypeError +notAForallTypeErrorNotAForallTypeError = Typed.TypedName (Core.Name "hydra.error.checking.NotAForallTypeError") + -- | DSL accessor for the type field of hydra.error.checking.NotAForallTypeError notAForallTypeErrorType :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm Core.Type notAForallTypeErrorType x = @@ -239,6 +254,10 @@ Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) +-- | DSL name token for hydra.error.checking.NotAFunctionTypeError +notAFunctionTypeErrorNotAFunctionTypeError :: Typed.TypedName Checking.NotAFunctionTypeError +notAFunctionTypeErrorNotAFunctionTypeError = Typed.TypedName (Core.Name "hydra.error.checking.NotAFunctionTypeError") + -- | DSL accessor for the type field of hydra.error.checking.NotAFunctionTypeError notAFunctionTypeErrorType :: Typed.TypedTerm Checking.NotAFunctionTypeError -> Typed.TypedTerm Core.Type notAFunctionTypeErrorType x = @@ -280,6 +299,10 @@ Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.OtherCheckingError +otherCheckingErrorOtherCheckingError :: Typed.TypedName Checking.OtherCheckingError +otherCheckingErrorOtherCheckingError = Typed.TypedName (Core.Name "hydra.error.checking.OtherCheckingError") + -- | DSL accessor for the path field of hydra.error.checking.OtherCheckingError otherCheckingErrorPath :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm Paths.SubtermPath otherCheckingErrorPath x = @@ -378,6 +401,10 @@ Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.TypeArityMismatchError +typeArityMismatchErrorTypeArityMismatchError :: Typed.TypedName Checking.TypeArityMismatchError +typeArityMismatchErrorTypeArityMismatchError = Typed.TypedName (Core.Name "hydra.error.checking.TypeArityMismatchError") + -- | DSL updater for the actualArity field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorWithActualArity :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Int -> Typed.TypedTerm Checking.TypeArityMismatchError typeArityMismatchErrorWithActualArity original newVal = @@ -533,6 +560,10 @@ Core.projectionFieldName = (Core.Name "expectedType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.TypeMismatchError +typeMismatchErrorTypeMismatchError :: Typed.TypedName Checking.TypeMismatchError +typeMismatchErrorTypeMismatchError = Typed.TypedName (Core.Name "hydra.error.checking.TypeMismatchError") + -- | DSL updater for the actualType field of hydra.error.checking.TypeMismatchError typeMismatchErrorWithActualType :: Typed.TypedTerm Checking.TypeMismatchError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.TypeMismatchError typeMismatchErrorWithActualType original newVal = @@ -589,6 +620,11 @@ Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.UnboundTypeVariablesError +unboundTypeVariablesErrorUnboundTypeVariablesError :: Typed.TypedName Checking.UnboundTypeVariablesError +unboundTypeVariablesErrorUnboundTypeVariablesError = + Typed.TypedName (Core.Name "hydra.error.checking.UnboundTypeVariablesError") + -- | DSL accessor for the variables field of hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesErrorVariables :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm (S.Set Core.Name) unboundTypeVariablesErrorVariables x = @@ -663,6 +699,11 @@ Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.UndefinedTermVariableCheckingError +undefinedTermVariableCheckingErrorUndefinedTermVariableCheckingError :: Typed.TypedName Checking.UndefinedTermVariableCheckingError +undefinedTermVariableCheckingErrorUndefinedTermVariableCheckingError = + Typed.TypedName (Core.Name "hydra.error.checking.UndefinedTermVariableCheckingError") + -- | DSL updater for the name field of hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorWithName :: Typed.TypedTerm Checking.UndefinedTermVariableCheckingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorWithName original newVal = @@ -728,6 +769,10 @@ Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.UnequalTypesError +unequalTypesErrorUnequalTypesError :: Typed.TypedName Checking.UnequalTypesError +unequalTypesErrorUnequalTypesError = Typed.TypedName (Core.Name "hydra.error.checking.UnequalTypesError") + -- | DSL updater for the description field of hydra.error.checking.UnequalTypesError unequalTypesErrorWithDescription :: Typed.TypedTerm Checking.UnequalTypesError -> Typed.TypedTerm String -> Typed.TypedTerm Checking.UnequalTypesError unequalTypesErrorWithDescription original newVal = @@ -781,6 +826,11 @@ Core.projectionFieldName = (Core.Name "termVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.UnsupportedTermVariantError +unsupportedTermVariantErrorUnsupportedTermVariantError :: Typed.TypedName Checking.UnsupportedTermVariantError +unsupportedTermVariantErrorUnsupportedTermVariantError = + Typed.TypedName (Core.Name "hydra.error.checking.UnsupportedTermVariantError") + -- | DSL updater for the termVariant field of hydra.error.checking.UnsupportedTermVariantError unsupportedTermVariantErrorWithTermVariant :: Typed.TypedTerm Checking.UnsupportedTermVariantError -> Typed.TypedTerm Variants.TermVariant -> Typed.TypedTerm Checking.UnsupportedTermVariantError unsupportedTermVariantErrorWithTermVariant original newVal = @@ -798,6 +848,10 @@ Core.recordTypeName = (Core.Name "hydra.error.checking.UntypedLambdaError"), Core.recordFields = []})) +-- | DSL name token for hydra.error.checking.UntypedLambdaError +untypedLambdaErrorUntypedLambdaError :: Typed.TypedName Checking.UntypedLambdaError +untypedLambdaErrorUntypedLambdaError = Typed.TypedName (Core.Name "hydra.error.checking.UntypedLambdaError") + -- | DSL constructor for hydra.error.checking.UntypedLetBindingError untypedLetBindingError :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Checking.UntypedLetBindingError untypedLetBindingError binding = @@ -817,6 +871,10 @@ Core.projectionFieldName = (Core.Name "binding")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.checking.UntypedLetBindingError +untypedLetBindingErrorUntypedLetBindingError :: Typed.TypedName Checking.UntypedLetBindingError +untypedLetBindingErrorUntypedLetBindingError = Typed.TypedName (Core.Name "hydra.error.checking.UntypedLetBindingError") + -- | DSL updater for the binding field of hydra.error.checking.UntypedLetBindingError untypedLetBindingErrorWithBinding :: Typed.TypedTerm Checking.UntypedLetBindingError -> Typed.TypedTerm Core.Binding -> Typed.TypedTerm Checking.UntypedLetBindingError untypedLetBindingErrorWithBinding original newVal = @@ -857,6 +915,11 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UntypedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.error.checking.UntypedTermVariableCheckingError +untypedTermVariableCheckingErrorUntypedTermVariableCheckingError :: Typed.TypedName Checking.UntypedTermVariableCheckingError +untypedTermVariableCheckingErrorUntypedTermVariableCheckingError = + Typed.TypedName (Core.Name "hydra.error.checking.UntypedTermVariableCheckingError") -- | DSL updater for the name field of hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorWithName :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Checking.UntypedTermVariableCheckingError diff --git a/src/main/haskell/Hydra/Dsl/Error/Core.hs b/src/main/haskell/Hydra/Dsl/Error/Core.hs --- a/src/main/haskell/Hydra/Dsl/Error/Core.hs +++ b/src/main/haskell/Hydra/Dsl/Error/Core.hs @@ -5,9 +5,11 @@ module Hydra.Dsl.Error.Core where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Error.Core as DecodeErrorCore import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Error.Core as EncodeErrorCore import qualified Hydra.Error.Core as ErrorCore import qualified Hydra.Paths as Paths import qualified Hydra.Typed as Typed @@ -28,6 +30,10 @@ Core.fieldName = (Core.Name "value"), Core.fieldTerm = (Typed.unTypedTerm value)}]})) +-- | DSL name token for hydra.error.core.ConstantConditionError +constantConditionErrorConstantConditionError :: Typed.TypedName ErrorCore.ConstantConditionError +constantConditionErrorConstantConditionError = Typed.TypedName (Core.Name "hydra.error.core.ConstantConditionError") + -- | DSL accessor for the location field of hydra.error.core.ConstantConditionError constantConditionErrorLocation :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm Paths.SubtermPath constantConditionErrorLocation x = @@ -93,6 +99,10 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.DuplicateBindingError +duplicateBindingErrorDuplicateBindingError :: Typed.TypedName ErrorCore.DuplicateBindingError +duplicateBindingErrorDuplicateBindingError = Typed.TypedName (Core.Name "hydra.error.core.DuplicateBindingError") + -- | DSL accessor for the location field of hydra.error.core.DuplicateBindingError duplicateBindingErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Paths.SubtermPath duplicateBindingErrorLocation x = @@ -158,6 +168,10 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.DuplicateFieldError +duplicateFieldErrorDuplicateFieldError :: Typed.TypedName ErrorCore.DuplicateFieldError +duplicateFieldErrorDuplicateFieldError = Typed.TypedName (Core.Name "hydra.error.core.DuplicateFieldError") + -- | DSL accessor for the location field of hydra.error.core.DuplicateFieldError duplicateFieldErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Paths.SubtermPath duplicateFieldErrorLocation x = @@ -223,6 +237,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.DuplicateRecordTypeFieldNamesError +duplicateRecordTypeFieldNamesErrorDuplicateRecordTypeFieldNamesError :: Typed.TypedName ErrorCore.DuplicateRecordTypeFieldNamesError +duplicateRecordTypeFieldNamesErrorDuplicateRecordTypeFieldNamesError = + Typed.TypedName (Core.Name "hydra.error.core.DuplicateRecordTypeFieldNamesError") + -- | DSL accessor for the location field of hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath duplicateRecordTypeFieldNamesErrorLocation x = @@ -288,6 +307,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.DuplicateUnionTypeFieldNamesError +duplicateUnionTypeFieldNamesErrorDuplicateUnionTypeFieldNamesError :: Typed.TypedName ErrorCore.DuplicateUnionTypeFieldNamesError +duplicateUnionTypeFieldNamesErrorDuplicateUnionTypeFieldNamesError = + Typed.TypedName (Core.Name "hydra.error.core.DuplicateUnionTypeFieldNamesError") + -- | DSL accessor for the location field of hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath duplicateUnionTypeFieldNamesErrorLocation x = @@ -353,6 +377,10 @@ Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm typeName)}]})) +-- | DSL name token for hydra.error.core.EmptyCaseStatementError +emptyCaseStatementErrorEmptyCaseStatementError :: Typed.TypedName ErrorCore.EmptyCaseStatementError +emptyCaseStatementErrorEmptyCaseStatementError = Typed.TypedName (Core.Name "hydra.error.core.EmptyCaseStatementError") + -- | DSL accessor for the location field of hydra.error.core.EmptyCaseStatementError emptyCaseStatementErrorLocation :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm Paths.SubtermPath emptyCaseStatementErrorLocation x = @@ -415,6 +443,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyLetBindingsError +emptyLetBindingsErrorEmptyLetBindingsError :: Typed.TypedName ErrorCore.EmptyLetBindingsError +emptyLetBindingsErrorEmptyLetBindingsError = Typed.TypedName (Core.Name "hydra.error.core.EmptyLetBindingsError") + -- | DSL accessor for the location field of hydra.error.core.EmptyLetBindingsError emptyLetBindingsErrorLocation :: Typed.TypedTerm ErrorCore.EmptyLetBindingsError -> Typed.TypedTerm Paths.SubtermPath emptyLetBindingsErrorLocation x = @@ -444,6 +476,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyRecordTypeError +emptyRecordTypeErrorEmptyRecordTypeError :: Typed.TypedName ErrorCore.EmptyRecordTypeError +emptyRecordTypeErrorEmptyRecordTypeError = Typed.TypedName (Core.Name "hydra.error.core.EmptyRecordTypeError") + -- | DSL accessor for the location field of hydra.error.core.EmptyRecordTypeError emptyRecordTypeErrorLocation :: Typed.TypedTerm ErrorCore.EmptyRecordTypeError -> Typed.TypedTerm Paths.SubtermPath emptyRecordTypeErrorLocation x = @@ -473,6 +509,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyTermAnnotationError +emptyTermAnnotationErrorEmptyTermAnnotationError :: Typed.TypedName ErrorCore.EmptyTermAnnotationError +emptyTermAnnotationErrorEmptyTermAnnotationError = Typed.TypedName (Core.Name "hydra.error.core.EmptyTermAnnotationError") + -- | DSL accessor for the location field of hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTermAnnotationError -> Typed.TypedTerm Paths.SubtermPath emptyTermAnnotationErrorLocation x = @@ -502,6 +542,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyTypeAnnotationError +emptyTypeAnnotationErrorEmptyTypeAnnotationError :: Typed.TypedName ErrorCore.EmptyTypeAnnotationError +emptyTypeAnnotationErrorEmptyTypeAnnotationError = Typed.TypedName (Core.Name "hydra.error.core.EmptyTypeAnnotationError") + -- | DSL accessor for the location field of hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError -> Typed.TypedTerm Paths.SubtermPath emptyTypeAnnotationErrorLocation x = @@ -531,6 +575,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyTypeNameInTermError +emptyTypeNameInTermErrorEmptyTypeNameInTermError :: Typed.TypedName ErrorCore.EmptyTypeNameInTermError +emptyTypeNameInTermErrorEmptyTypeNameInTermError = Typed.TypedName (Core.Name "hydra.error.core.EmptyTypeNameInTermError") + -- | DSL accessor for the location field of hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError -> Typed.TypedTerm Paths.SubtermPath emptyTypeNameInTermErrorLocation x = @@ -560,6 +608,10 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) +-- | DSL name token for hydra.error.core.EmptyUnionTypeError +emptyUnionTypeErrorEmptyUnionTypeError :: Typed.TypedName ErrorCore.EmptyUnionTypeError +emptyUnionTypeErrorEmptyUnionTypeError = Typed.TypedName (Core.Name "hydra.error.core.EmptyUnionTypeError") + -- | DSL accessor for the location field of hydra.error.core.EmptyUnionTypeError emptyUnionTypeErrorLocation :: Typed.TypedTerm ErrorCore.EmptyUnionTypeError -> Typed.TypedTerm Paths.SubtermPath emptyUnionTypeErrorLocation x = @@ -592,6 +644,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.InvalidForallParameterNameError +invalidForallParameterNameErrorInvalidForallParameterNameError :: Typed.TypedName ErrorCore.InvalidForallParameterNameError +invalidForallParameterNameErrorInvalidForallParameterNameError = + Typed.TypedName (Core.Name "hydra.error.core.InvalidForallParameterNameError") + -- | DSL accessor for the location field of hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidForallParameterNameErrorLocation x = @@ -657,6 +714,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.InvalidLambdaParameterNameError +invalidLambdaParameterNameErrorInvalidLambdaParameterNameError :: Typed.TypedName ErrorCore.InvalidLambdaParameterNameError +invalidLambdaParameterNameErrorInvalidLambdaParameterNameError = + Typed.TypedName (Core.Name "hydra.error.core.InvalidLambdaParameterNameError") + -- | DSL accessor for the location field of hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidLambdaParameterNameErrorLocation x = @@ -722,6 +784,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.InvalidLetBindingNameError +invalidLetBindingNameErrorInvalidLetBindingNameError :: Typed.TypedName ErrorCore.InvalidLetBindingNameError +invalidLetBindingNameErrorInvalidLetBindingNameError = + Typed.TypedName (Core.Name "hydra.error.core.InvalidLetBindingNameError") + -- | DSL accessor for the location field of hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm Paths.SubtermPath invalidLetBindingNameErrorLocation x = @@ -774,6 +841,10 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL name token for hydra.error.core.InvalidLiteralError +invalidLiteralErrorInvalidLiteralError :: Typed.TypedName ErrorCore.InvalidLiteralError +invalidLiteralErrorInvalidLiteralError = Typed.TypedName (Core.Name "hydra.error.core.InvalidLiteralError") + -- | DSL injection for the typeMismatch variant of hydra.error.core.InvalidLiteralError invalidLiteralErrorTypeMismatch :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm ErrorCore.InvalidLiteralError invalidLiteralErrorTypeMismatch x = @@ -864,6 +935,10 @@ Core.fieldName = (Core.Name "invalidLetBindingName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.error.core.InvalidTermError +invalidTermErrorInvalidTermError :: Typed.TypedName ErrorCore.InvalidTermError +invalidTermErrorInvalidTermError = Typed.TypedName (Core.Name "hydra.error.core.InvalidTermError") + -- | DSL injection for the invalidTypeLambdaParameterName variant of hydra.error.core.InvalidTermError invalidTermErrorInvalidTypeLambdaParameterName :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorInvalidTypeLambdaParameterName x = @@ -873,6 +948,15 @@ Core.fieldName = (Core.Name "invalidTypeLambdaParameterName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the missingCaseBranches variant of hydra.error.core.InvalidTermError +invalidTermErrorMissingCaseBranches :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm ErrorCore.InvalidTermError +invalidTermErrorMissingCaseBranches x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "missingCaseBranches"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the nestedTermAnnotation variant of hydra.error.core.InvalidTermError invalidTermErrorNestedTermAnnotation :: Typed.TypedTerm ErrorCore.NestedTermAnnotationError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorNestedTermAnnotation x = @@ -954,6 +1038,15 @@ Core.fieldName = (Core.Name "undefinedTypeVariableInTypeApplication"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the unknownCaseAlternative variant of hydra.error.core.InvalidTermError +invalidTermErrorUnknownCaseAlternative :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm ErrorCore.InvalidTermError +invalidTermErrorUnknownCaseAlternative x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "unknownCaseAlternative"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unknownPrimitiveName variant of hydra.error.core.InvalidTermError invalidTermErrorUnknownPrimitiveName :: Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUnknownPrimitiveName x = @@ -1035,6 +1128,10 @@ Core.fieldName = (Core.Name "invalidForallParameterName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.error.core.InvalidTypeError +invalidTypeErrorInvalidTypeError :: Typed.TypedName ErrorCore.InvalidTypeError +invalidTypeErrorInvalidTypeError = Typed.TypedName (Core.Name "hydra.error.core.InvalidTypeError") + -- | DSL injection for the invalidTypeSchemeVariableName variant of hydra.error.core.InvalidTypeError invalidTypeErrorInvalidTypeSchemeVariableName :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorInvalidTypeSchemeVariableName x = @@ -1120,6 +1217,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.InvalidTypeLambdaParameterNameError +invalidTypeLambdaParameterNameErrorInvalidTypeLambdaParameterNameError :: Typed.TypedName ErrorCore.InvalidTypeLambdaParameterNameError +invalidTypeLambdaParameterNameErrorInvalidTypeLambdaParameterNameError = + Typed.TypedName (Core.Name "hydra.error.core.InvalidTypeLambdaParameterNameError") + -- | DSL accessor for the location field of hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidTypeLambdaParameterNameErrorLocation x = @@ -1185,6 +1287,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.core.InvalidTypeSchemeVariableNameError +invalidTypeSchemeVariableNameErrorInvalidTypeSchemeVariableNameError :: Typed.TypedName ErrorCore.InvalidTypeSchemeVariableNameError +invalidTypeSchemeVariableNameErrorInvalidTypeSchemeVariableNameError = + Typed.TypedName (Core.Name "hydra.error.core.InvalidTypeSchemeVariableNameError") + -- | DSL accessor for the location field of hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm Paths.SubtermPath invalidTypeSchemeVariableNameErrorLocation x = @@ -1268,6 +1375,10 @@ Core.projectionFieldName = (Core.Name "expectedType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.LiteralTypeMismatchError +literalTypeMismatchErrorLiteralTypeMismatchError :: Typed.TypedName ErrorCore.LiteralTypeMismatchError +literalTypeMismatchErrorLiteralTypeMismatchError = Typed.TypedName (Core.Name "hydra.error.core.LiteralTypeMismatchError") + -- | DSL updater for the actualType field of hydra.error.core.LiteralTypeMismatchError literalTypeMismatchErrorWithActualType :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm ErrorCore.LiteralTypeMismatchError literalTypeMismatchErrorWithActualType original newVal = @@ -1302,6 +1413,125 @@ Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) +-- | DSL constructor for hydra.error.core.MissingCaseBranchesError +missingCaseBranchesError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.MissingCaseBranchesError +missingCaseBranchesError location typeName variantNames = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Typed.unTypedTerm location)}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Typed.unTypedTerm typeName)}, + Core.Field { + Core.fieldName = (Core.Name "variantNames"), + Core.fieldTerm = (Typed.unTypedTerm variantNames)}]})) + +-- | DSL accessor for the location field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorLocation :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm Paths.SubtermPath +missingCaseBranchesErrorLocation x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorMissingCaseBranchesError :: Typed.TypedName ErrorCore.MissingCaseBranchesError +missingCaseBranchesErrorMissingCaseBranchesError = Typed.TypedName (Core.Name "hydra.error.core.MissingCaseBranchesError") + +-- | DSL accessor for the typeName field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorTypeName :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm Core.Name +missingCaseBranchesErrorTypeName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the variantNames field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorVariantNames :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm [Core.Name] +missingCaseBranchesErrorVariantNames x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "variantNames")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the location field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorWithLocation :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.MissingCaseBranchesError +missingCaseBranchesErrorWithLocation original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "variantNames"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "variantNames")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the typeName field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorWithTypeName :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.MissingCaseBranchesError +missingCaseBranchesErrorWithTypeName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "variantNames"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "variantNames")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the variantNames field of hydra.error.core.MissingCaseBranchesError +missingCaseBranchesErrorWithVariantNames :: Typed.TypedTerm ErrorCore.MissingCaseBranchesError -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.MissingCaseBranchesError +missingCaseBranchesErrorWithVariantNames original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "variantNames"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTermAnnotationError nestedTermAnnotationError location = @@ -1321,6 +1551,11 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.NestedTermAnnotationError +nestedTermAnnotationErrorNestedTermAnnotationError :: Typed.TypedName ErrorCore.NestedTermAnnotationError +nestedTermAnnotationErrorNestedTermAnnotationError = + Typed.TypedName (Core.Name "hydra.error.core.NestedTermAnnotationError") + -- | DSL updater for the location field of hydra.error.core.NestedTermAnnotationError nestedTermAnnotationErrorWithLocation :: Typed.TypedTerm ErrorCore.NestedTermAnnotationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTermAnnotationError nestedTermAnnotationErrorWithLocation original newVal = @@ -1350,6 +1585,11 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.NestedTypeAnnotationError +nestedTypeAnnotationErrorNestedTypeAnnotationError :: Typed.TypedName ErrorCore.NestedTypeAnnotationError +nestedTypeAnnotationErrorNestedTypeAnnotationError = + Typed.TypedName (Core.Name "hydra.error.core.NestedTypeAnnotationError") + -- | DSL updater for the location field of hydra.error.core.NestedTypeAnnotationError nestedTypeAnnotationErrorWithLocation :: Typed.TypedTerm ErrorCore.NestedTypeAnnotationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTypeAnnotationError nestedTypeAnnotationErrorWithLocation original newVal = @@ -1391,6 +1631,11 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.NonComparableMapKeyTypeError +nonComparableMapKeyTypeErrorNonComparableMapKeyTypeError :: Typed.TypedName ErrorCore.NonComparableMapKeyTypeError +nonComparableMapKeyTypeErrorNonComparableMapKeyTypeError = + Typed.TypedName (Core.Name "hydra.error.core.NonComparableMapKeyTypeError") + -- | DSL updater for the keyType field of hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorWithKeyType :: Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorWithKeyType original newVal = @@ -1456,6 +1701,11 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.NonComparableSetElementTypeError +nonComparableSetElementTypeErrorNonComparableSetElementTypeError :: Typed.TypedName ErrorCore.NonComparableSetElementTypeError +nonComparableSetElementTypeErrorNonComparableSetElementTypeError = + Typed.TypedName (Core.Name "hydra.error.core.NonComparableSetElementTypeError") + -- | DSL updater for the elementType field of hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeErrorWithElementType :: Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError nonComparableSetElementTypeErrorWithElementType original newVal = @@ -1512,6 +1762,10 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.RedundantWrapUnwrapError +redundantWrapUnwrapErrorRedundantWrapUnwrapError :: Typed.TypedName ErrorCore.RedundantWrapUnwrapError +redundantWrapUnwrapErrorRedundantWrapUnwrapError = Typed.TypedName (Core.Name "hydra.error.core.RedundantWrapUnwrapError") + -- | DSL accessor for the typeName field of hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapErrorTypeName :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm Core.Name redundantWrapUnwrapErrorTypeName x = @@ -1586,6 +1840,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.SelfApplicationError +selfApplicationErrorSelfApplicationError :: Typed.TypedName ErrorCore.SelfApplicationError +selfApplicationErrorSelfApplicationError = Typed.TypedName (Core.Name "hydra.error.core.SelfApplicationError") + -- | DSL updater for the location field of hydra.error.core.SelfApplicationError selfApplicationErrorWithLocation :: Typed.TypedTerm ErrorCore.SelfApplicationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.SelfApplicationError selfApplicationErrorWithLocation original newVal = @@ -1651,6 +1909,10 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.SingleVariantUnionError +singleVariantUnionErrorSingleVariantUnionError :: Typed.TypedName ErrorCore.SingleVariantUnionError +singleVariantUnionErrorSingleVariantUnionError = Typed.TypedName (Core.Name "hydra.error.core.SingleVariantUnionError") + -- | DSL updater for the fieldName field of hydra.error.core.SingleVariantUnionError singleVariantUnionErrorWithFieldName :: Typed.TypedTerm ErrorCore.SingleVariantUnionError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.SingleVariantUnionError singleVariantUnionErrorWithFieldName original newVal = @@ -1716,6 +1978,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.TermVariableShadowingError +termVariableShadowingErrorTermVariableShadowingError :: Typed.TypedName ErrorCore.TermVariableShadowingError +termVariableShadowingErrorTermVariableShadowingError = + Typed.TypedName (Core.Name "hydra.error.core.TermVariableShadowingError") + -- | DSL updater for the location field of hydra.error.core.TermVariableShadowingError termVariableShadowingErrorWithLocation :: Typed.TypedTerm ErrorCore.TermVariableShadowingError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.TermVariableShadowingError termVariableShadowingErrorWithLocation original newVal = @@ -1781,6 +2048,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.TypeVariableShadowingInForallError +typeVariableShadowingInForallErrorTypeVariableShadowingInForallError :: Typed.TypedName ErrorCore.TypeVariableShadowingInForallError +typeVariableShadowingInForallErrorTypeVariableShadowingInForallError = + Typed.TypedName (Core.Name "hydra.error.core.TypeVariableShadowingInForallError") + -- | DSL updater for the location field of hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorWithLocation :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorWithLocation original newVal = @@ -1846,6 +2118,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.TypeVariableShadowingInTypeLambdaError +typeVariableShadowingInTypeLambdaErrorTypeVariableShadowingInTypeLambdaError :: Typed.TypedName ErrorCore.TypeVariableShadowingInTypeLambdaError +typeVariableShadowingInTypeLambdaErrorTypeVariableShadowingInTypeLambdaError = + Typed.TypedName (Core.Name "hydra.error.core.TypeVariableShadowingInTypeLambdaError") + -- | DSL updater for the location field of hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorWithLocation :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorWithLocation original newVal = @@ -1911,6 +2188,10 @@ Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedFieldError +undefinedFieldErrorUndefinedFieldError :: Typed.TypedName ErrorCore.UndefinedFieldError +undefinedFieldErrorUndefinedFieldError = Typed.TypedName (Core.Name "hydra.error.core.UndefinedFieldError") + -- | DSL updater for the fieldName field of hydra.error.core.UndefinedFieldError undefinedFieldErrorWithFieldName :: Typed.TypedTerm ErrorCore.UndefinedFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedFieldError undefinedFieldErrorWithFieldName original newVal = @@ -1976,6 +2257,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedTermVariableError +undefinedTermVariableErrorUndefinedTermVariableError :: Typed.TypedName ErrorCore.UndefinedTermVariableError +undefinedTermVariableErrorUndefinedTermVariableError = + Typed.TypedName (Core.Name "hydra.error.core.UndefinedTermVariableError") + -- | DSL updater for the location field of hydra.error.core.UndefinedTermVariableError undefinedTermVariableErrorWithLocation :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndefinedTermVariableError undefinedTermVariableErrorWithLocation original newVal = @@ -2041,6 +2327,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedTypeVariableError +undefinedTypeVariableErrorUndefinedTypeVariableError :: Typed.TypedName ErrorCore.UndefinedTypeVariableError +undefinedTypeVariableErrorUndefinedTypeVariableError = + Typed.TypedName (Core.Name "hydra.error.core.UndefinedTypeVariableError") + -- | DSL updater for the location field of hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableErrorWithLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableError undefinedTypeVariableErrorWithLocation original newVal = @@ -2106,6 +2397,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedTypeVariableInBindingTypeError +undefinedTypeVariableInBindingTypeErrorUndefinedTypeVariableInBindingTypeError :: Typed.TypedName ErrorCore.UndefinedTypeVariableInBindingTypeError +undefinedTypeVariableInBindingTypeErrorUndefinedTypeVariableInBindingTypeError = + Typed.TypedName (Core.Name "hydra.error.core.UndefinedTypeVariableInBindingTypeError") + -- | DSL updater for the location field of hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorWithLocation original newVal = @@ -2171,6 +2467,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedTypeVariableInLambdaDomainError +undefinedTypeVariableInLambdaDomainErrorUndefinedTypeVariableInLambdaDomainError :: Typed.TypedName ErrorCore.UndefinedTypeVariableInLambdaDomainError +undefinedTypeVariableInLambdaDomainErrorUndefinedTypeVariableInLambdaDomainError = + Typed.TypedName (Core.Name "hydra.error.core.UndefinedTypeVariableInLambdaDomainError") + -- | DSL updater for the location field of hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorWithLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorWithLocation original newVal = @@ -2236,6 +2537,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UndefinedTypeVariableInTypeApplicationError +undefinedTypeVariableInTypeApplicationErrorUndefinedTypeVariableInTypeApplicationError :: Typed.TypedName ErrorCore.UndefinedTypeVariableInTypeApplicationError +undefinedTypeVariableInTypeApplicationErrorUndefinedTypeVariableInTypeApplicationError = + Typed.TypedName (Core.Name "hydra.error.core.UndefinedTypeVariableInTypeApplicationError") + -- | DSL updater for the location field of hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorWithLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorWithLocation original newVal = @@ -2301,6 +2607,11 @@ Core.projectionFieldName = (Core.Name "expectedVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UnexpectedTermVariantError +unexpectedTermVariantErrorUnexpectedTermVariantError :: Typed.TypedName ErrorCore.UnexpectedTermVariantError +unexpectedTermVariantErrorUnexpectedTermVariantError = + Typed.TypedName (Core.Name "hydra.error.core.UnexpectedTermVariantError") + -- | DSL updater for the actualTerm field of hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantErrorWithActualTerm :: Typed.TypedTerm ErrorCore.UnexpectedTermVariantError -> Typed.TypedTerm Core.Term -> Typed.TypedTerm ErrorCore.UnexpectedTermVariantError unexpectedTermVariantErrorWithActualTerm original newVal = @@ -2366,6 +2677,11 @@ Core.projectionFieldName = (Core.Name "expectedVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UnexpectedTypeVariantError +unexpectedTypeVariantErrorUnexpectedTypeVariantError :: Typed.TypedName ErrorCore.UnexpectedTypeVariantError +unexpectedTypeVariantErrorUnexpectedTypeVariantError = + Typed.TypedName (Core.Name "hydra.error.core.UnexpectedTypeVariantError") + -- | DSL updater for the actualType field of hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantErrorWithActualType :: Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError unexpectedTypeVariantErrorWithActualType original newVal = @@ -2400,6 +2716,126 @@ Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) +-- | DSL constructor for hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeError location typeName name = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Typed.unTypedTerm location)}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Typed.unTypedTerm typeName)}, + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (Typed.unTypedTerm name)}]})) + +-- | DSL accessor for the location field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorLocation :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Paths.SubtermPath +unknownCaseAlternativeErrorLocation x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the name field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorName :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Core.Name +unknownCaseAlternativeErrorName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "name")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the typeName field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorTypeName :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Core.Name +unknownCaseAlternativeErrorTypeName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorUnknownCaseAlternativeError :: Typed.TypedName ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeErrorUnknownCaseAlternativeError = + Typed.TypedName (Core.Name "hydra.error.core.UnknownCaseAlternativeError") + +-- | DSL updater for the location field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithLocation :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithLocation original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "name")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the name field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithName :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "typeName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the typeName field of hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithTypeName :: Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownCaseAlternativeError +unknownCaseAlternativeErrorWithTypeName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "location")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.projectionFieldName = (Core.Name "name")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError unknownPrimitiveNameError location name = @@ -2431,6 +2867,11 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UnknownPrimitiveNameError +unknownPrimitiveNameErrorUnknownPrimitiveNameError :: Typed.TypedName ErrorCore.UnknownPrimitiveNameError +unknownPrimitiveNameErrorUnknownPrimitiveNameError = + Typed.TypedName (Core.Name "hydra.error.core.UnknownPrimitiveNameError") + -- | DSL updater for the location field of hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameErrorWithLocation :: Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError unknownPrimitiveNameErrorWithLocation original newVal = @@ -2484,6 +2925,11 @@ Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UnnecessaryIdentityApplicationError +unnecessaryIdentityApplicationErrorUnnecessaryIdentityApplicationError :: Typed.TypedName ErrorCore.UnnecessaryIdentityApplicationError +unnecessaryIdentityApplicationErrorUnnecessaryIdentityApplicationError = + Typed.TypedName (Core.Name "hydra.error.core.UnnecessaryIdentityApplicationError") + -- | DSL updater for the location field of hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationErrorWithLocation :: Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationErrorWithLocation original newVal = @@ -2525,6 +2971,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.core.UntypedTermVariableError +untypedTermVariableErrorUntypedTermVariableError :: Typed.TypedName ErrorCore.UntypedTermVariableError +untypedTermVariableErrorUntypedTermVariableError = Typed.TypedName (Core.Name "hydra.error.core.UntypedTermVariableError") + -- | DSL updater for the location field of hydra.error.core.UntypedTermVariableError untypedTermVariableErrorWithLocation :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UntypedTermVariableError untypedTermVariableErrorWithLocation original newVal = @@ -2577,6 +3027,11 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.VoidInNonBottomPositionError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.error.core.VoidInNonBottomPositionError +voidInNonBottomPositionErrorVoidInNonBottomPositionError :: Typed.TypedName ErrorCore.VoidInNonBottomPositionError +voidInNonBottomPositionErrorVoidInNonBottomPositionError = + Typed.TypedName (Core.Name "hydra.error.core.VoidInNonBottomPositionError") -- | DSL updater for the location field of hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionErrorWithLocation :: Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError diff --git a/src/main/haskell/Hydra/Dsl/Error/File.hs b/src/main/haskell/Hydra/Dsl/Error/File.hs --- a/src/main/haskell/Hydra/Dsl/Error/File.hs +++ b/src/main/haskell/Hydra/Dsl/Error/File.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Error.File where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Error.File as DecodeErrorFile import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Encode.Error.File as EncodeErrorFile import qualified Hydra.Error.File as ErrorFile import qualified Hydra.File as File import qualified Hydra.Typed as Typed @@ -20,6 +22,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "alreadyExists"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL name token for hydra.error.file.FileError +fileErrorFileError :: Typed.TypedName ErrorFile.FileError +fileErrorFileError = Typed.TypedName (Core.Name "hydra.error.file.FileError") -- | DSL injection for the invalidPath variant of hydra.error.file.FileError fileErrorInvalidPath :: Typed.TypedTerm String -> Typed.TypedTerm ErrorFile.FileError diff --git a/src/main/haskell/Hydra/Dsl/Error/Packaging.hs b/src/main/haskell/Hydra/Dsl/Error/Packaging.hs --- a/src/main/haskell/Hydra/Dsl/Error/Packaging.hs +++ b/src/main/haskell/Hydra/Dsl/Error/Packaging.hs @@ -5,9 +5,11 @@ module Hydra.Dsl.Error.Packaging where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Error.Packaging as DecodeErrorPackaging import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Packaging as DslPackaging import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Encode.Error.Packaging as EncodeErrorPackaging import qualified Hydra.Error.Packaging as ErrorPackaging import qualified Hydra.Packaging as Packaging import qualified Hydra.Typed as Typed @@ -28,6 +30,11 @@ Core.fieldName = (Core.Name "second"), Core.fieldTerm = (Typed.unTypedTerm second)}]})) +-- | DSL name token for hydra.error.packaging.ConflictingModuleNameError +conflictingModuleNameErrorConflictingModuleNameError :: Typed.TypedName ErrorPackaging.ConflictingModuleNameError +conflictingModuleNameErrorConflictingModuleNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.ConflictingModuleNameError") + -- | DSL accessor for the first field of hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameErrorFirst :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm Packaging.ModuleName conflictingModuleNameErrorFirst x = @@ -108,6 +115,11 @@ Core.projectionFieldName = (Core.Name "conflictingName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.packaging.ConflictingVariantNameError +conflictingVariantNameErrorConflictingVariantNameError :: Typed.TypedName ErrorPackaging.ConflictingVariantNameError +conflictingVariantNameErrorConflictingVariantNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.ConflictingVariantNameError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Packaging.ModuleName conflictingVariantNameErrorModuleName x = @@ -272,6 +284,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.packaging.DefinitionNotInModuleNameError +definitionNotInModuleNameErrorDefinitionNotInModuleNameError :: Typed.TypedName ErrorPackaging.DefinitionNotInModuleNameError +definitionNotInModuleNameErrorDefinitionNotInModuleNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.DefinitionNotInModuleNameError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm Packaging.ModuleName definitionNotInModuleNameErrorModuleName x = @@ -340,6 +357,11 @@ Core.fieldName = (Core.Name "followingName"), Core.fieldTerm = (Typed.unTypedTerm followingName)}]})) +-- | DSL name token for hydra.error.packaging.DefinitionsOutOfOrderError +definitionsOutOfOrderErrorDefinitionsOutOfOrderError :: Typed.TypedName ErrorPackaging.DefinitionsOutOfOrderError +definitionsOutOfOrderErrorDefinitionsOutOfOrderError = + Typed.TypedName (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError") + -- | DSL accessor for the followingName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorFollowingName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Core.Name definitionsOutOfOrderErrorFollowingName x = @@ -452,6 +474,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.packaging.DuplicateDefinitionNameError +duplicateDefinitionNameErrorDuplicateDefinitionNameError :: Typed.TypedName ErrorPackaging.DuplicateDefinitionNameError +duplicateDefinitionNameErrorDuplicateDefinitionNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.DuplicateDefinitionNameError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName duplicateDefinitionNameErrorModuleName x = @@ -514,6 +541,11 @@ Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm moduleName)}]})) +-- | DSL name token for hydra.error.packaging.DuplicateModuleNameError +duplicateModuleNameErrorDuplicateModuleNameError :: Typed.TypedName ErrorPackaging.DuplicateModuleNameError +duplicateModuleNameErrorDuplicateModuleNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.DuplicateModuleNameError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError -> Typed.TypedTerm Packaging.ModuleName duplicateModuleNameErrorModuleName x = @@ -558,6 +590,11 @@ Core.projectionFieldName = (Core.Name "expectedConvention")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.error.packaging.InvalidDefinitionNameError +invalidDefinitionNameErrorInvalidDefinitionNameError :: Typed.TypedName ErrorPackaging.InvalidDefinitionNameError +invalidDefinitionNameErrorInvalidDefinitionNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.InvalidDefinitionNameError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName invalidDefinitionNameErrorModuleName x = @@ -693,6 +730,10 @@ Core.fieldName = (Core.Name "invalidDefinitionName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.error.packaging.InvalidModuleError +invalidModuleErrorInvalidModuleError :: Typed.TypedName ErrorPackaging.InvalidModuleError +invalidModuleErrorInvalidModuleError = Typed.TypedName (Core.Name "hydra.error.packaging.InvalidModuleError") + -- | DSL injection for the invalidModuleNameConvention variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorInvalidModuleNameConvention :: Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorInvalidModuleNameConvention x = @@ -721,6 +762,11 @@ Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm moduleName)}]})) +-- | DSL name token for hydra.error.packaging.InvalidModuleNameConventionError +invalidModuleNameConventionErrorInvalidModuleNameConventionError :: Typed.TypedName ErrorPackaging.InvalidModuleNameConventionError +invalidModuleNameConventionErrorInvalidModuleNameConventionError = + Typed.TypedName (Core.Name "hydra.error.packaging.InvalidModuleNameConventionError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionErrorModuleName :: Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError -> Typed.TypedTerm Packaging.ModuleName invalidModuleNameConventionErrorModuleName x = @@ -767,6 +813,10 @@ Core.fieldName = (Core.Name "invalidModule"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.error.packaging.InvalidPackageError +invalidPackageErrorInvalidPackageError :: Typed.TypedName ErrorPackaging.InvalidPackageError +invalidPackageErrorInvalidPackageError = Typed.TypedName (Core.Name "hydra.error.packaging.InvalidPackageError") + -- | DSL injection for the invalidPackageName variant of hydra.error.packaging.InvalidPackageError invalidPackageErrorInvalidPackageName :: Typed.TypedTerm ErrorPackaging.InvalidPackageNameError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError invalidPackageErrorInvalidPackageName x = @@ -776,6 +826,15 @@ Core.fieldName = (Core.Name "invalidPackageName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the undeclaredDependency variant of hydra.error.packaging.InvalidPackageError +invalidPackageErrorUndeclaredDependency :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError +invalidPackageErrorUndeclaredDependency x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.packaging.InvalidPackageError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "undeclaredDependency"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.error.packaging.InvalidPackageNameError invalidPackageNameError :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm ErrorPackaging.InvalidPackageNameError invalidPackageNameError packageName = @@ -786,6 +845,11 @@ Core.fieldName = (Core.Name "packageName"), Core.fieldTerm = (Typed.unTypedTerm packageName)}]})) +-- | DSL name token for hydra.error.packaging.InvalidPackageNameError +invalidPackageNameErrorInvalidPackageNameError :: Typed.TypedName ErrorPackaging.InvalidPackageNameError +invalidPackageNameErrorInvalidPackageNameError = + Typed.TypedName (Core.Name "hydra.error.packaging.InvalidPackageNameError") + -- | DSL accessor for the packageName field of hydra.error.packaging.InvalidPackageNameError invalidPackageNameErrorPackageName :: Typed.TypedTerm ErrorPackaging.InvalidPackageNameError -> Typed.TypedTerm Packaging.PackageName invalidPackageNameErrorPackageName x = @@ -818,6 +882,11 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.error.packaging.MissingDocumentationError +missingDocumentationErrorMissingDocumentationError :: Typed.TypedName ErrorPackaging.MissingDocumentationError +missingDocumentationErrorMissingDocumentationError = + Typed.TypedName (Core.Name "hydra.error.packaging.MissingDocumentationError") + -- | DSL accessor for the moduleName field of hydra.error.packaging.MissingDocumentationError missingDocumentationErrorModuleName :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm Packaging.ModuleName missingDocumentationErrorModuleName x = @@ -869,3 +938,123 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL constructor for hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyError moduleName referencedName owningModuleName = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "moduleName"), + Core.fieldTerm = (Typed.unTypedTerm moduleName)}, + Core.Field { + Core.fieldName = (Core.Name "referencedName"), + Core.fieldTerm = (Typed.unTypedTerm referencedName)}, + Core.Field { + Core.fieldName = (Core.Name "owningModuleName"), + Core.fieldTerm = (Typed.unTypedTerm owningModuleName)}]})) + +-- | DSL accessor for the moduleName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorModuleName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Packaging.ModuleName +undeclaredDependencyErrorModuleName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "moduleName")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the owningModuleName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorOwningModuleName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Packaging.ModuleName +undeclaredDependencyErrorOwningModuleName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "owningModuleName")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the referencedName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorReferencedName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Core.Name +undeclaredDependencyErrorReferencedName x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "referencedName")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorUndeclaredDependencyError :: Typed.TypedName ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyErrorUndeclaredDependencyError = + Typed.TypedName (Core.Name "hydra.error.packaging.UndeclaredDependencyError") + +-- | DSL updater for the moduleName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyErrorWithModuleName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "moduleName"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "referencedName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "referencedName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "owningModuleName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "owningModuleName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the owningModuleName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorWithOwningModuleName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyErrorWithOwningModuleName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "moduleName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "moduleName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "referencedName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "referencedName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "owningModuleName"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the referencedName field of hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyErrorWithReferencedName :: Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.UndeclaredDependencyError +undeclaredDependencyErrorWithReferencedName original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "moduleName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "moduleName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "referencedName"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "owningModuleName"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.projectionFieldName = (Core.Name "owningModuleName")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) diff --git a/src/main/haskell/Hydra/Dsl/Error/System.hs b/src/main/haskell/Hydra/Dsl/Error/System.hs --- a/src/main/haskell/Hydra/Dsl/Error/System.hs +++ b/src/main/haskell/Hydra/Dsl/Error/System.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Error.System where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Error.System as DecodeErrorSystem import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Encode.Error.System as EncodeErrorSystem import qualified Hydra.Error.System as System import qualified Hydra.File as File import qualified Hydra.Typed as Typed @@ -56,3 +58,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "permissionDenied"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL name token for hydra.error.system.SystemError +systemErrorSystemError :: Typed.TypedName System.SystemError +systemErrorSystemError = Typed.TypedName (Core.Name "hydra.error.system.SystemError") diff --git a/src/main/haskell/Hydra/Dsl/Errors.hs b/src/main/haskell/Hydra/Dsl/Errors.hs --- a/src/main/haskell/Hydra/Dsl/Errors.hs +++ b/src/main/haskell/Hydra/Dsl/Errors.hs @@ -5,12 +5,14 @@ module Hydra.Dsl.Errors where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Errors as DecodeErrors import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Error.Checking as ErrorChecking import qualified Hydra.Dsl.Error.Core as DslErrorCore import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Typing as DslTyping import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Encode.Errors as EncodeErrors import qualified Hydra.Error.Checking as Checking import qualified Hydra.Error.Core as ErrorCore import qualified Hydra.Errors as Errors @@ -28,6 +30,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.DecodingError +decodingErrorDecodingError :: Typed.TypedName Errors.DecodingError +decodingErrorDecodingError = Typed.TypedName (Core.Name "hydra.errors.DecodingError") + -- | DSL injection for the checking variant of hydra.errors.Error errorChecking :: Typed.TypedTerm Checking.CheckingError -> Typed.TypedTerm Errors.Error errorChecking x = @@ -64,6 +70,10 @@ Core.fieldName = (Core.Name "duplicateField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.errors.Error +errorError :: Typed.TypedName Errors.Error +errorError = Typed.TypedName (Core.Name "hydra.errors.Error") + -- | DSL injection for the extraction variant of hydra.errors.Error errorExtraction :: Typed.TypedTerm Errors.ExtractionError -> Typed.TypedTerm Errors.Error errorExtraction x = @@ -172,6 +182,10 @@ Core.fieldName = (Core.Name "emptyList"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.errors.ExtractionError +extractionErrorExtractionError :: Typed.TypedName Errors.ExtractionError +extractionErrorExtractionError = Typed.TypedName (Core.Name "hydra.errors.ExtractionError") + -- | DSL injection for the multipleBindings variant of hydra.errors.ExtractionError extractionErrorMultipleBindings :: Typed.TypedTerm Errors.MultipleBindingsError -> Typed.TypedTerm Errors.ExtractionError extractionErrorMultipleBindings x = @@ -235,6 +249,10 @@ Core.fieldName = (Core.Name "checking"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.errors.InferenceError +inferenceErrorInferenceError :: Typed.TypedName Errors.InferenceError +inferenceErrorInferenceError = Typed.TypedName (Core.Name "hydra.errors.InferenceError") + -- | DSL injection for the other variant of hydra.errors.InferenceError inferenceErrorOther :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm Errors.InferenceError inferenceErrorOther x = @@ -263,6 +281,10 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) +-- | DSL name token for hydra.errors.MultipleBindingsError +multipleBindingsErrorMultipleBindingsError :: Typed.TypedName Errors.MultipleBindingsError +multipleBindingsErrorMultipleBindingsError = Typed.TypedName (Core.Name "hydra.errors.MultipleBindingsError") + -- | DSL accessor for the name field of hydra.errors.MultipleBindingsError multipleBindingsErrorName :: Typed.TypedTerm Errors.MultipleBindingsError -> Typed.TypedTerm Core.Name multipleBindingsErrorName x = @@ -301,6 +323,10 @@ Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.MultipleFieldsError +multipleFieldsErrorMultipleFieldsError :: Typed.TypedName Errors.MultipleFieldsError +multipleFieldsErrorMultipleFieldsError = Typed.TypedName (Core.Name "hydra.errors.MultipleFieldsError") + -- | DSL updater for the fieldName field of hydra.errors.MultipleFieldsError multipleFieldsErrorWithFieldName :: Typed.TypedTerm Errors.MultipleFieldsError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.MultipleFieldsError multipleFieldsErrorWithFieldName original newVal = @@ -330,6 +356,10 @@ Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.NoMatchingFieldError +noMatchingFieldErrorNoMatchingFieldError :: Typed.TypedName Errors.NoMatchingFieldError +noMatchingFieldErrorNoMatchingFieldError = Typed.TypedName (Core.Name "hydra.errors.NoMatchingFieldError") + -- | DSL updater for the fieldName field of hydra.errors.NoMatchingFieldError noMatchingFieldErrorWithFieldName :: Typed.TypedTerm Errors.NoMatchingFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoMatchingFieldError noMatchingFieldErrorWithFieldName original newVal = @@ -359,6 +389,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.NoSuchBindingError +noSuchBindingErrorNoSuchBindingError :: Typed.TypedName Errors.NoSuchBindingError +noSuchBindingErrorNoSuchBindingError = Typed.TypedName (Core.Name "hydra.errors.NoSuchBindingError") + -- | DSL updater for the name field of hydra.errors.NoSuchBindingError noSuchBindingErrorWithName :: Typed.TypedTerm Errors.NoSuchBindingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoSuchBindingError noSuchBindingErrorWithName original newVal = @@ -388,6 +422,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.NoSuchPrimitiveError +noSuchPrimitiveErrorNoSuchPrimitiveError :: Typed.TypedName Errors.NoSuchPrimitiveError +noSuchPrimitiveErrorNoSuchPrimitiveError = Typed.TypedName (Core.Name "hydra.errors.NoSuchPrimitiveError") + -- | DSL updater for the name field of hydra.errors.NoSuchPrimitiveError noSuchPrimitiveErrorWithName :: Typed.TypedTerm Errors.NoSuchPrimitiveError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoSuchPrimitiveError noSuchPrimitiveErrorWithName original newVal = @@ -405,6 +443,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.OtherError +otherErrorOtherError :: Typed.TypedName Errors.OtherError +otherErrorOtherError = Typed.TypedName (Core.Name "hydra.errors.OtherError") + -- | DSL constructor for hydra.errors.OtherInferenceError otherInferenceError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm String -> Typed.TypedTerm Errors.OtherInferenceError otherInferenceError path message = @@ -427,6 +469,10 @@ Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.OtherInferenceError +otherInferenceErrorOtherInferenceError :: Typed.TypedName Errors.OtherInferenceError +otherInferenceErrorOtherInferenceError = Typed.TypedName (Core.Name "hydra.errors.OtherInferenceError") + -- | DSL accessor for the path field of hydra.errors.OtherInferenceError otherInferenceErrorPath :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm Paths.SubtermPath otherInferenceErrorPath x = @@ -477,6 +523,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherResolutionError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.OtherResolutionError +otherResolutionErrorOtherResolutionError :: Typed.TypedName Errors.OtherResolutionError +otherResolutionErrorOtherResolutionError = Typed.TypedName (Core.Name "hydra.errors.OtherResolutionError") + -- | DSL injection for the noMatchingField variant of hydra.errors.ResolutionError resolutionErrorNoMatchingField :: Typed.TypedTerm Errors.NoMatchingFieldError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorNoMatchingField x = @@ -513,6 +563,10 @@ Core.fieldName = (Core.Name "other"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.errors.ResolutionError +resolutionErrorResolutionError :: Typed.TypedName Errors.ResolutionError +resolutionErrorResolutionError = Typed.TypedName (Core.Name "hydra.errors.ResolutionError") + -- | DSL injection for the unexpectedShape variant of hydra.errors.ResolutionError resolutionErrorUnexpectedShape :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorUnexpectedShape x = @@ -574,6 +628,10 @@ Core.projectionFieldName = (Core.Name "expected")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.UnexpectedShapeError +unexpectedShapeErrorUnexpectedShapeError :: Typed.TypedName Errors.UnexpectedShapeError +unexpectedShapeErrorUnexpectedShapeError = Typed.TypedName (Core.Name "hydra.errors.UnexpectedShapeError") + -- | DSL updater for the actual field of hydra.errors.UnexpectedShapeError unexpectedShapeErrorWithActual :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm String -> Typed.TypedTerm Errors.UnexpectedShapeError unexpectedShapeErrorWithActual original newVal = @@ -651,6 +709,10 @@ Core.projectionFieldName = (Core.Name "rightType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.errors.UnificationError +unificationErrorUnificationError :: Typed.TypedName Errors.UnificationError +unificationErrorUnificationError = Typed.TypedName (Core.Name "hydra.errors.UnificationError") + -- | DSL updater for the leftType field of hydra.errors.UnificationError unificationErrorWithLeftType :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Errors.UnificationError unificationErrorWithLeftType original newVal = @@ -753,6 +815,10 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationInferenceError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.errors.UnificationInferenceError +unificationInferenceErrorUnificationInferenceError :: Typed.TypedName Errors.UnificationInferenceError +unificationInferenceErrorUnificationInferenceError = Typed.TypedName (Core.Name "hydra.errors.UnificationInferenceError") -- | DSL updater for the cause field of hydra.errors.UnificationInferenceError unificationInferenceErrorWithCause :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Errors.UnificationInferenceError diff --git a/src/main/haskell/Hydra/Dsl/Extract/Json.hs b/src/main/haskell/Hydra/Dsl/Extract/Json.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Extract/Json.hs @@ -0,0 +1,167 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.extract.json + +module Hydra.Dsl.Extract.Json where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Json.Writer as JsonWriter +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Json as Json +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Json.Writer as Writer +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.extract.json.expectArray +expectArray :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String [Model.Value]) +expectArray arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.expectArray")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.extract.json.expectNumber +expectNumber :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Sci.Scientific) +expectNumber arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.expectNumber")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.extract.json.expectObject +expectObject :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String (M.Map String Model.Value)) +expectObject arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.expectObject")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.extract.json.expectString +expectString :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String String) +expectString arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.expectString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.extract.json.opt +opt :: Ord t0 => (Typed.TypedTerm t0 -> Typed.TypedTerm (M.Map t0 t1) -> Typed.TypedTerm (Maybe t1)) +opt arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.opt")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.optArray +optArray :: Ord t0 => (Typed.TypedTerm t0 -> Typed.TypedTerm (M.Map t0 Model.Value) -> Typed.TypedTerm (Either String (Maybe [Model.Value]))) +optArray arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.optArray")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.optString +optString :: Ord t0 => (Typed.TypedTerm t0 -> Typed.TypedTerm (M.Map t0 Model.Value) -> Typed.TypedTerm (Either String (Maybe String))) +optString arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.optString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.require +require :: Typed.TypedTerm String -> Typed.TypedTerm (M.Map String t0) -> Typed.TypedTerm (Either String t0) +require arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.require")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.requireArray +requireArray :: Typed.TypedTerm String -> Typed.TypedTerm (M.Map String Model.Value) -> Typed.TypedTerm (Either String [Model.Value]) +requireArray arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.requireArray")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.requireNumber +requireNumber :: Typed.TypedTerm String -> Typed.TypedTerm (M.Map String Model.Value) -> Typed.TypedTerm (Either String Sci.Scientific) +requireNumber arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.requireNumber")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.requireString +requireString :: Typed.TypedTerm String -> Typed.TypedTerm (M.Map String Model.Value) -> Typed.TypedTerm (Either String String) +requireString arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.requireString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.extract.json.showValue +showValue :: Typed.TypedTerm Model.Value -> Typed.TypedTerm String +showValue arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.json.showValue")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/File.hs b/src/main/haskell/Hydra/Dsl/File.hs --- a/src/main/haskell/Hydra/Dsl/File.hs +++ b/src/main/haskell/Hydra/Dsl/File.hs @@ -5,8 +5,10 @@ module Hydra.Dsl.File where import qualified Hydra.Core as Core +import qualified Hydra.Decode.File as DecodeFile import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Encode.File as EncodeFile import qualified Hydra.File as File import qualified Hydra.Time as Time import qualified Hydra.Typed as Typed @@ -21,6 +23,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.file.FileExtension"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.file.FileExtension +fileExtensionFileExtension :: Typed.TypedName File.FileExtension +fileExtensionFileExtension = Typed.TypedName (Core.Name "hydra.file.FileExtension") + -- | DSL constructor for the hydra.file.FilePath wrapper filePath :: Typed.TypedTerm String -> Typed.TypedTerm File.FilePath filePath x = @@ -28,6 +34,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.file.FilePath"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.file.FilePath +filePathFilePath :: Typed.TypedName File.FilePath +filePathFilePath = Typed.TypedName (Core.Name "hydra.file.FilePath") + -- | DSL constructor for hydra.file.FileStatus fileStatus :: Typed.TypedTerm File.FileType -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm Time.Timespec -> Typed.TypedTerm (Maybe Time.Timespec) -> Typed.TypedTerm (Maybe Time.Timespec) -> Typed.TypedTerm File.FileStatus fileStatus fileType size modificationTime accessTime statusChangeTime = @@ -59,6 +69,10 @@ Core.projectionFieldName = (Core.Name "accessTime")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.file.FileStatus +fileStatusFileStatus :: Typed.TypedName File.FileStatus +fileStatusFileStatus = Typed.TypedName (Core.Name "hydra.file.FileStatus") + -- | DSL accessor for the fileType field of hydra.file.FileStatus fileStatusFileType :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm File.FileType fileStatusFileType x = @@ -320,6 +334,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "fifo"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.file.FileType +fileTypeFileType :: Typed.TypedName File.FileType +fileTypeFileType = Typed.TypedName (Core.Name "hydra.file.FileType") -- | DSL injection for the link variant of hydra.file.FileType fileTypeLink :: Typed.TypedTerm File.FileType diff --git a/src/main/haskell/Hydra/Dsl/Formatting.hs b/src/main/haskell/Hydra/Dsl/Formatting.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Formatting.hs @@ -0,0 +1,207 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.formatting + +module Hydra.Dsl.Formatting where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +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.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Set as S + +-- | DSL reference to hydra.formatting.capitalize +capitalize :: Typed.TypedTerm String -> Typed.TypedTerm String +capitalize arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.capitalize")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.convertCase +convertCase :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm String -> Typed.TypedTerm String +convertCase arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.convertCase")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.formatting.convertCaseCamelOrUnderscoreToLowerSnake +convertCaseCamelOrUnderscoreToLowerSnake :: Typed.TypedTerm String -> Typed.TypedTerm String +convertCaseCamelOrUnderscoreToLowerSnake arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.convertCaseCamelOrUnderscoreToLowerSnake")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.convertCaseCamelToLowerSnake +convertCaseCamelToLowerSnake :: Typed.TypedTerm String -> Typed.TypedTerm String +convertCaseCamelToLowerSnake arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.convertCaseCamelToLowerSnake")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.convertCaseCamelToUpperSnake +convertCaseCamelToUpperSnake :: Typed.TypedTerm String -> Typed.TypedTerm String +convertCaseCamelToUpperSnake arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.convertCaseCamelToUpperSnake")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.convertCasePascalToUpperSnake +convertCasePascalToUpperSnake :: Typed.TypedTerm String -> Typed.TypedTerm String +convertCasePascalToUpperSnake arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.convertCasePascalToUpperSnake")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.decapitalize +decapitalize :: Typed.TypedTerm String -> Typed.TypedTerm String +decapitalize arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.decapitalize")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.escapeWithUnderscore +escapeWithUnderscore :: Typed.TypedTerm (S.Set String) -> Typed.TypedTerm String -> Typed.TypedTerm String +escapeWithUnderscore arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.escapeWithUnderscore")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.formatting.indentLines +indentLines :: Typed.TypedTerm String -> Typed.TypedTerm String +indentLines arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.indentLines")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.javaStyleComment +javaStyleComment :: Typed.TypedTerm String -> Typed.TypedTerm String +javaStyleComment arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.javaStyleComment")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.mapFirstLetter +mapFirstLetter :: Typed.TypedTerm (String -> String) -> Typed.TypedTerm String -> Typed.TypedTerm String +mapFirstLetter arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.mapFirstLetter")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.formatting.nonAlnumToUnderscores +nonAlnumToUnderscores :: Typed.TypedTerm String -> Typed.TypedTerm String +nonAlnumToUnderscores arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.nonAlnumToUnderscores")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.normalizeComment +normalizeComment :: Typed.TypedTerm String -> Typed.TypedTerm String +normalizeComment arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.normalizeComment")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.sanitizeWithUnderscores +sanitizeWithUnderscores :: Typed.TypedTerm (S.Set String) -> Typed.TypedTerm String -> Typed.TypedTerm String +sanitizeWithUnderscores arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.sanitizeWithUnderscores")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.formatting.showList +showList :: Typed.TypedTerm (t0 -> String) -> Typed.TypedTerm [t0] -> Typed.TypedTerm String +showList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.showList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.formatting.stripLeadingAndTrailingWhitespace +stripLeadingAndTrailingWhitespace :: Typed.TypedTerm String -> Typed.TypedTerm String +stripLeadingAndTrailingWhitespace arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.stripLeadingAndTrailingWhitespace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.withCharacterAliases +withCharacterAliases :: Typed.TypedTerm String -> Typed.TypedTerm String +withCharacterAliases arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.withCharacterAliases")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.formatting.wrapLine +wrapLine :: Typed.TypedTerm Int -> Typed.TypedTerm String -> Typed.TypedTerm String +wrapLine arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.formatting.wrapLine")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) diff --git a/src/main/haskell/Hydra/Dsl/Graph.hs b/src/main/haskell/Hydra/Dsl/Graph.hs --- a/src/main/haskell/Hydra/Dsl/Graph.hs +++ b/src/main/haskell/Hydra/Dsl/Graph.hs @@ -19,6 +19,20 @@ import qualified Data.Map as M import qualified Data.Set as S +-- | DSL composition builder for the decoder of hydra.graph.TermCoder +decodeTermCoder :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Graph.TermCoder a)) +decodeTermCoder a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.graph.termCoder")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the encoder of hydra.graph.TermCoder +encodeTermCoder :: Typed.TypedTerm (a -> Core.Term) -> Typed.TypedTerm (Graph.TermCoder a -> Core.Term) +encodeTermCoder a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.graph.termCoder")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + -- | DSL constructor for hydra.graph.Graph graph :: Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm (M.Map Core.Name Graph.Primitive) -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Graph.Graph graph boundTerms boundTypes classConstraints lambdaVariables metadata primitives schemaTypes typeVariables = @@ -77,6 +91,10 @@ Core.projectionFieldName = (Core.Name "classConstraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.graph.Graph +graphGraph :: Typed.TypedName Graph.Graph +graphGraph = Typed.TypedName (Core.Name "hydra.graph.Graph") + -- | DSL accessor for the lambdaVariables field of hydra.graph.Graph graphLambdaVariables :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (S.Set Core.Name) graphLambdaVariables x = @@ -610,6 +628,10 @@ Core.fieldName = (Core.Name "primitives"), Core.fieldTerm = (Typed.unTypedTerm primitives)}]})) +-- | DSL name token for hydra.graph.Library +libraryLibrary :: Typed.TypedName Graph.Library +libraryLibrary = Typed.TypedName (Core.Name "hydra.graph.Library") + -- | DSL accessor for the name field of hydra.graph.Library libraryName :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm Packaging.ModuleName libraryName x = @@ -740,6 +762,10 @@ Core.projectionFieldName = (Core.Name "implementation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.graph.Primitive +primitivePrimitive :: Typed.TypedName Graph.Primitive +primitivePrimitive = Typed.TypedName (Core.Name "hydra.graph.Primitive") + -- | DSL updater for the definition field of hydra.graph.Primitive primitiveWithDefinition :: Typed.TypedTerm Graph.Primitive -> Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Graph.Primitive primitiveWithDefinition original newVal = @@ -807,6 +833,10 @@ Core.projectionTypeName = (Core.Name "hydra.graph.TermCoder"), Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.graph.TermCoder +termCoderTermCoder :: Typed.TypedName (Graph.TermCoder a) +termCoderTermCoder = Typed.TypedName (Core.Name "hydra.graph.TermCoder") -- | DSL accessor for the type field of hydra.graph.TermCoder termCoderType :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm Core.Type diff --git a/src/main/haskell/Hydra/Dsl/Json/Bootstrap.hs b/src/main/haskell/Hydra/Dsl/Json/Bootstrap.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Bootstrap.hs @@ -0,0 +1,37 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.bootstrap + +module Hydra.Dsl.Json.Bootstrap where + +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Bootstrap as Bootstrap +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Paths as Paths +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.bootstrap.typesByName +typesByName :: Typed.TypedTerm (M.Map Core.Name Core.Type) +typesByName = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.bootstrap.typesByName")) diff --git a/src/main/haskell/Hydra/Dsl/Json/Decode.hs b/src/main/haskell/Hydra/Dsl/Json/Decode.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Decode.hs @@ -0,0 +1,155 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.decode + +module Hydra.Dsl.Json.Decode where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Decode as Decode +import qualified Hydra.Json.Model as Model +import qualified Hydra.Literals as Literals +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.decode.decodeFloat +decodeFloat :: Typed.TypedTerm Core.FloatType -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term) +decodeFloat arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.decodeFloat")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.json.decode.decodeInteger +decodeInteger :: Typed.TypedTerm Core.IntegerType -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term) +decodeInteger arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.decodeInteger")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.json.decode.decodeLiteral +decodeLiteral :: Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term) +decodeLiteral arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.decodeLiteral")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.json.decode.expectArray +expectArray :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String [Model.Value]) +expectArray arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.expectArray")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decode.expectNumber +expectNumber :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Sci.Scientific) +expectNumber arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.expectNumber")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decode.expectObject +expectObject :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String (M.Map String Model.Value)) +expectObject arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.expectObject")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decode.expectString +expectString :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String String) +expectString arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.expectString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decode.fromJson +fromJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term) +fromJson arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.fromJson")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.json.decode.parseSpecialFloat +parseSpecialFloat :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Double) +parseSpecialFloat arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.parseSpecialFloat")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decode.parseSpecialFloat32 +parseSpecialFloat32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Float) +parseSpecialFloat32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.parseSpecialFloat32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Json/Decoding.hs b/src/main/haskell/Hydra/Dsl/Json/Decoding.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Decoding.hs @@ -0,0 +1,119 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.decoding + +module Hydra.Dsl.Json.Decoding where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Decoding as Decoding +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.decoding.decodeArray +decodeArray :: Typed.TypedTerm (Model.Value -> Either String t0) -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String [t0]) +decodeArray arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeArray")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.json.decoding.decodeBoolean +decodeBoolean :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Bool) +decodeBoolean arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeBoolean")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decoding.decodeField +decodeField :: Typed.TypedTerm (t0 -> Either String t1) -> Typed.TypedTerm String -> Typed.TypedTerm (M.Map String t0) -> Typed.TypedTerm (Either String t1) +decodeField arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeField")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.json.decoding.decodeObject +decodeObject :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String (M.Map String Model.Value)) +decodeObject arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeObject")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.decoding.decodeOptionalField +decodeOptionalField :: Ord t3 => (Typed.TypedTerm (t0 -> Either t1 t2) -> Typed.TypedTerm t3 -> Typed.TypedTerm (M.Map t3 t0) -> Typed.TypedTerm (Either t1 (Maybe t2))) +decodeOptionalField arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeOptionalField")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.json.decoding.decodeString +decodeString :: Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String String) +decodeString arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decoding.decodeString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Json/Encode.hs b/src/main/haskell/Hydra/Dsl/Json/Encode.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Encode.hs @@ -0,0 +1,121 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.encode + +module Hydra.Dsl.Json.Encode where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Encode as Encode +import qualified Hydra.Json.Model as Model +import qualified Hydra.Literals as Literals +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.encode.encodeFloat +encodeFloat :: Typed.TypedTerm Core.FloatValue -> Typed.TypedTerm (Either t0 Model.Value) +encodeFloat arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.encodeFloat")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.encode.encodeInteger +encodeInteger :: Typed.TypedTerm Core.IntegerValue -> Typed.TypedTerm (Either t0 Model.Value) +encodeInteger arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.encodeInteger")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.encode.encodeLiteral +encodeLiteral :: Typed.TypedTerm Core.Literal -> Typed.TypedTerm (Either t0 Model.Value) +encodeLiteral arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.encodeLiteral")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.encode.requiresJsonStringSentinel +requiresJsonStringSentinel :: Typed.TypedTerm String -> Typed.TypedTerm Bool +requiresJsonStringSentinel arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.requiresJsonStringSentinel")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.encode.toJson +toJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Model.Value) +toJson arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.toJson")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.json.encode.toJsonUntyped +toJsonUntyped :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Model.Value) +toJsonUntyped arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.toJsonUntyped")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Json/Model.hs b/src/main/haskell/Hydra/Dsl/Json/Model.hs --- a/src/main/haskell/Hydra/Dsl/Json/Model.hs +++ b/src/main/haskell/Hydra/Dsl/Json/Model.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Json.Model where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Json.Model as DecodeJsonModel import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Json.Model as EncodeJsonModel import qualified Hydra.Json.Model as Model import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -64,3 +66,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL name token for hydra.json.model.Value +valueValue :: Typed.TypedName Model.Value +valueValue = Typed.TypedName (Core.Name "hydra.json.model.Value") diff --git a/src/main/haskell/Hydra/Dsl/Json/Parser.hs b/src/main/haskell/Hydra/Dsl/Json/Parser.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Parser.hs @@ -0,0 +1,145 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.parser + +module Hydra.Dsl.Json.Parser where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Json.Parser as Parser +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsers as Parsers +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.json.parser.digit +digit :: Typed.TypedTerm (Parsing.Parser Int) +digit = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.digit")) + +-- | DSL reference to hydra.json.parser.digits +digits :: Typed.TypedTerm (Parsing.Parser String) +digits = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.digits")) + +-- | DSL reference to hydra.json.parser.jsonArray +jsonArray :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonArray = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonArray")) + +-- | DSL reference to hydra.json.parser.jsonBool +jsonBool :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonBool = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonBool")) + +-- | DSL reference to hydra.json.parser.jsonEscapeChar +jsonEscapeChar :: Typed.TypedTerm (Parsing.Parser Int) +jsonEscapeChar = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonEscapeChar")) + +-- | DSL reference to hydra.json.parser.jsonExponentPart +jsonExponentPart :: Typed.TypedTerm (Parsing.Parser (Maybe String)) +jsonExponentPart = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonExponentPart")) + +-- | DSL reference to hydra.json.parser.jsonFractionPart +jsonFractionPart :: Typed.TypedTerm (Parsing.Parser (Maybe String)) +jsonFractionPart = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonFractionPart")) + +-- | DSL reference to hydra.json.parser.jsonIntegerPart +jsonIntegerPart :: Typed.TypedTerm (Parsing.Parser String) +jsonIntegerPart = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonIntegerPart")) + +-- | DSL reference to hydra.json.parser.jsonKeyValue +jsonKeyValue :: Typed.TypedTerm (Parsing.Parser (String, Model.Value)) +jsonKeyValue = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonKeyValue")) + +-- | DSL reference to hydra.json.parser.jsonNull +jsonNull :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonNull = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonNull")) + +-- | DSL reference to hydra.json.parser.jsonNumber +jsonNumber :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonNumber = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonNumber")) + +-- | DSL reference to hydra.json.parser.jsonObject +jsonObject :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonObject = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonObject")) + +-- | DSL reference to hydra.json.parser.jsonString +jsonString :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonString = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonString")) + +-- | DSL reference to hydra.json.parser.jsonStringChar +jsonStringChar :: Typed.TypedTerm (Parsing.Parser Int) +jsonStringChar = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonStringChar")) + +-- | DSL reference to hydra.json.parser.jsonValue +jsonValue :: Typed.TypedTerm (Parsing.Parser Model.Value) +jsonValue = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.jsonValue")) + +-- | DSL reference to hydra.json.parser.parseJson +parseJson :: Typed.TypedTerm String -> Typed.TypedTerm (Parsing.ParseResult Model.Value) +parseJson arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.parser.parseJson")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.parser.token +token :: Typed.TypedTerm (Parsing.Parser t0) -> Typed.TypedTerm (Parsing.Parser t0) +token arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.parser.token")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.parser.whitespace +whitespace :: Typed.TypedTerm (Parsing.Parser ()) +whitespace = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.parser.whitespace")) diff --git a/src/main/haskell/Hydra/Dsl/Json/Writer.hs b/src/main/haskell/Hydra/Dsl/Json/Writer.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Writer.hs @@ -0,0 +1,107 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.writer + +module Hydra.Dsl.Json.Writer where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Serialization as DslSerialization +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Json.Writer as Writer +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Serialization as Serialization +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.json.writer.colonOp +colonOp :: Typed.TypedTerm Ast.Op +colonOp = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.json.writer.colonOp")) + +-- | DSL reference to hydra.json.writer.hexByte +hexByte :: Typed.TypedTerm Int -> Typed.TypedTerm String +hexByte arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.writer.hexByte")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.writer.jsonString +jsonString :: Typed.TypedTerm String -> Typed.TypedTerm String +jsonString arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.writer.jsonString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.writer.keyValueToExpr +keyValueToExpr :: Typed.TypedTerm (String, Model.Value) -> Typed.TypedTerm Ast.Expr +keyValueToExpr arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.writer.keyValueToExpr")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.writer.printJson +printJson :: Typed.TypedTerm Model.Value -> Typed.TypedTerm String +printJson arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.writer.printJson")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.writer.valueToExpr +valueToExpr :: Typed.TypedTerm Model.Value -> Typed.TypedTerm Ast.Expr +valueToExpr arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.writer.valueToExpr")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Json/Yaml/Decode.hs b/src/main/haskell/Hydra/Dsl/Json/Yaml/Decode.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Yaml/Decode.hs @@ -0,0 +1,91 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.yaml.decode + +module Hydra.Dsl.Json.Yaml.Decode where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Decode as JsonDecode +import qualified Hydra.Dsl.Json.Model as DslJsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Dsl.Yaml.Model as DslYamlModel +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Decode as Decode +import qualified Hydra.Json.Model as JsonModel +import qualified Hydra.Json.Yaml.Decode as YamlDecode +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import qualified Hydra.Yaml.Model as YamlModel +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.yaml.decode.fromYaml +fromYaml :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm YamlModel.Node -> Typed.TypedTerm (Either String Core.Term) +fromYaml arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.yaml.decode.fromYaml")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.json.yaml.decode.yamlToJson +yamlToJson :: Typed.TypedTerm YamlModel.Node -> Typed.TypedTerm (Either String JsonModel.Value) +yamlToJson arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.yaml.decode.yamlToJson")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Json/Yaml/Encode.hs b/src/main/haskell/Hydra/Dsl/Json/Yaml/Encode.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Json/Yaml/Encode.hs @@ -0,0 +1,91 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.json.yaml.encode + +module Hydra.Dsl.Json.Yaml.Encode where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Encode as JsonEncode +import qualified Hydra.Dsl.Json.Model as DslJsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Dsl.Yaml.Model as DslYamlModel +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Encode as Encode +import qualified Hydra.Json.Model as JsonModel +import qualified Hydra.Json.Yaml.Encode as YamlEncode +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import qualified Hydra.Yaml.Model as YamlModel +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.json.yaml.encode.jsonToYaml +jsonToYaml :: Typed.TypedTerm JsonModel.Value -> Typed.TypedTerm YamlModel.Node +jsonToYaml arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.yaml.encode.jsonToYaml")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.json.yaml.encode.toYaml +toYaml :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String YamlModel.Node) +toYaml arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.yaml.encode.toYaml")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) diff --git a/src/main/haskell/Hydra/Dsl/Lexical.hs b/src/main/haskell/Hydra/Dsl/Lexical.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lexical.hs @@ -0,0 +1,301 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lexical + +module Hydra.Dsl.Lexical where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.lexical.buildGraph +buildGraph :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (M.Map Core.Name (Maybe Core.Term)) -> Typed.TypedTerm (M.Map Core.Name Graph.Primitive) -> Typed.TypedTerm Graph.Graph +buildGraph arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.buildGraph")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lexical.chooseUniqueName +chooseUniqueName :: Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name +chooseUniqueName arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.chooseUniqueName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.dereferenceSchemaType +dereferenceSchemaType :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm (Maybe Core.TypeScheme) +dereferenceSchemaType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.dereferenceSchemaType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.dereferenceVariable +dereferenceVariable :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.Binding) +dereferenceVariable arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.dereferenceVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.elementsToGraph +elementsToGraph :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Graph.Graph +elementsToGraph arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.elementsToGraph")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lexical.emptyGraph +emptyGraph :: Typed.TypedTerm Graph.Graph +emptyGraph = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lexical.emptyGraph")) + +-- | DSL reference to hydra.lexical.emptyInferenceContext +emptyInferenceContext :: Typed.TypedTerm Typing.InferenceContext +emptyInferenceContext = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lexical.emptyInferenceContext")) + +-- | DSL reference to hydra.lexical.fieldsOf +fieldsOf :: Typed.TypedTerm Core.Type -> Typed.TypedTerm [Core.FieldType] +fieldsOf arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.fieldsOf")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lexical.getField +getField :: Typed.TypedTerm (M.Map Core.Name t0) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (t0 -> Either Errors.Error t1) -> Typed.TypedTerm (Either Errors.Error t1) +getField arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.getField")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lexical.graphToBindings +graphToBindings :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm [Core.Binding] +graphToBindings arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.graphToBindings")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lexical.graphWithPrimitives +graphWithPrimitives :: Typed.TypedTerm [Graph.Primitive] -> Typed.TypedTerm [Graph.Primitive] -> Typed.TypedTerm Graph.Graph +graphWithPrimitives arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.graphWithPrimitives")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.lookupBinding +lookupBinding :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Binding) +lookupBinding arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.lookupBinding")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.lookupPrimitive +lookupPrimitive :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Graph.Primitive) +lookupPrimitive arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.lookupPrimitive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.lookupTerm +lookupTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Term) +lookupTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.lookupTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.matchEnum +matchEnum :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [(Core.Name, t0)] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error t0) +matchEnum arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.matchEnum")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.lexical.matchRecord +matchRecord :: Typed.TypedTerm t0 -> Typed.TypedTerm (M.Map Core.Name Core.Term -> Either Errors.Error t1) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error t1) +matchRecord arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.matchRecord")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lexical.matchUnion +matchUnion :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [(Core.Name, (Core.Term -> Either Errors.Error t0))] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error t0) +matchUnion arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.matchUnion")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.lexical.matchUnitField +matchUnitField :: Typed.TypedTerm t0 -> Typed.TypedTerm t1 -> Typed.TypedTerm (t0, (t2 -> Either t3 t1)) +matchUnitField arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.matchUnitField")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.requireBinding +requireBinding :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.Binding) +requireBinding arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.requireBinding")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.requirePrimitive +requirePrimitive :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Graph.Primitive) +requirePrimitive arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.requirePrimitive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.requirePrimitiveType +requirePrimitiveType :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.TypeScheme) +requirePrimitiveType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.requirePrimitiveType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.requireTerm +requireTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.Term) +requireTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.requireTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.resolveTerm +resolveTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Term) +resolveTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.resolveTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.stripAndDereferenceTerm +stripAndDereferenceTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error Core.Term) +stripAndDereferenceTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.stripAndDereferenceTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lexical.stripAndDereferenceTermEither +stripAndDereferenceTermEither :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error Core.Term) +stripAndDereferenceTermEither arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lexical.stripAndDereferenceTermEither")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Chars.hs b/src/main/haskell/Hydra/Dsl/Lib/Chars.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Chars.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Chars.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -62,44 +64,58 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +-- | DSL reference to hydra.lib.chars.isAlpha +isAlpha :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isAlpha char = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isAlpha")), + Core.applicationArgument = (Typed.unTypedTerm char)})) + -- | DSL reference to hydra.lib.chars.isAlphaNum isAlphaNum :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -isAlphaNum arg0 = +isAlphaNum char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isAlphaNum")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) +-- | DSL reference to hydra.lib.chars.isDigit +isDigit :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isDigit char = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isDigit")), + Core.applicationArgument = (Typed.unTypedTerm char)})) + -- | DSL reference to hydra.lib.chars.isLower isLower :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -isLower arg0 = +isLower char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isLower")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) -- | DSL reference to hydra.lib.chars.isSpace isSpace :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -isSpace arg0 = +isSpace char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isSpace")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) -- | DSL reference to hydra.lib.chars.isUpper isUpper :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -isUpper arg0 = +isUpper char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isUpper")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) -- | DSL reference to hydra.lib.chars.toLower toLower :: Typed.TypedTerm Int -> Typed.TypedTerm Int -toLower arg0 = +toLower char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.toLower")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) -- | DSL reference to hydra.lib.chars.toUpper toUpper :: Typed.TypedTerm Int -> Typed.TypedTerm Int -toUpper arg0 = +toUpper char = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.toUpper")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm char)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Defaults.hs b/src/main/haskell/Hydra/Dsl/Lib/Defaults.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Defaults.hs @@ -0,0 +1,26 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.defaults + +module Hydra.Dsl.Lib.Defaults where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Lib.Eithers as Eithers +import qualified Hydra.Dsl.Lib.Equality as Equality +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Logic as Logic +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Math as Math +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Pairs as Pairs +import qualified Hydra.Dsl.Lib.Sets as Sets +import qualified Hydra.Lib.Defaults as Defaults +import qualified Hydra.Typed as Typed +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.lib.defaults.defaultImplementations +defaultImplementations :: Typed.TypedTerm (M.Map Core.Name Core.Term) +defaultImplementations = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.defaults.defaultImplementations")) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs b/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -63,133 +65,142 @@ import qualified Data.Scientific as Sci import qualified Data.Set as S +-- | DSL reference to hydra.lib.eithers.apply +apply :: Typed.TypedTerm (Either x (y -> z)) -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm (Either x z) +apply ef ex = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.apply")), + Core.applicationArgument = (Typed.unTypedTerm ef)})), + Core.applicationArgument = (Typed.unTypedTerm ex)})) + -- | DSL reference to hydra.lib.eithers.bimap bimap :: Typed.TypedTerm (x -> z) -> Typed.TypedTerm (y -> w) -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm (Either z w) -bimap arg0 arg1 arg2 = +bimap f g e = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bimap")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) -- | DSL reference to hydra.lib.eithers.bind bind :: Typed.TypedTerm (Either x y) -> Typed.TypedTerm (y -> Either x z) -> Typed.TypedTerm (Either x z) -bind arg0 arg1 = +bind e f = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm e)})), + Core.applicationArgument = (Typed.unTypedTerm f)})) --- | DSL reference to hydra.lib.eithers.either -either :: Typed.TypedTerm (x -> z) -> Typed.TypedTerm (y -> z) -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm z -either arg0 arg1 arg2 = +-- | DSL reference to hydra.lib.eithers.compose +compose :: Typed.TypedTerm (x -> Either w y) -> Typed.TypedTerm (y -> Either w z) -> Typed.TypedTerm x -> Typed.TypedTerm (Either w z) +compose f g x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.compose")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) --- | DSL reference to hydra.lib.eithers.foldl -foldl :: Typed.TypedTerm (x -> y -> Either z x) -> Typed.TypedTerm x -> Typed.TypedTerm [y] -> Typed.TypedTerm (Either z x) -foldl arg0 arg1 arg2 = +-- | DSL reference to hydra.lib.eithers.either +either :: Typed.TypedTerm (x -> z) -> Typed.TypedTerm (y -> z) -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm z +either f g e = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.foldl")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) - --- | DSL reference to hydra.lib.eithers.fromLeft -fromLeft :: Typed.TypedTerm x -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm x -fromLeft arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.fromLeft")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) --- | DSL reference to hydra.lib.eithers.fromRight -fromRight :: Typed.TypedTerm y -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm y -fromRight arg0 arg1 = +-- | DSL reference to hydra.lib.eithers.foldList +foldList :: Typed.TypedTerm (x -> y -> Either z x) -> Typed.TypedTerm x -> Typed.TypedTerm [y] -> Typed.TypedTerm (Either z x) +foldList f acc0 xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.fromRight")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.foldList")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm acc0)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.eithers.isLeft isLeft :: Typed.TypedTerm (Either x y) -> Typed.TypedTerm Bool -isLeft arg0 = +isLeft e = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.isLeft")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm e)})) -- | DSL reference to hydra.lib.eithers.isRight isRight :: Typed.TypedTerm (Either x y) -> Typed.TypedTerm Bool -isRight arg0 = +isRight e = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.isRight")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm e)})) -- | DSL reference to hydra.lib.eithers.lefts lefts :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm [x] -lefts arg0 = +lefts xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.lefts")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.eithers.map map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm (Either z x) -> Typed.TypedTerm (Either z y) -map arg0 arg1 = +map f e = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm e)})) -- | DSL reference to hydra.lib.eithers.mapList mapList :: Typed.TypedTerm (x -> Either z y) -> Typed.TypedTerm [x] -> Typed.TypedTerm (Either z [y]) -mapList arg0 arg1 = +mapList f xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.mapList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.eithers.mapOptional mapOptional :: Typed.TypedTerm (x -> Either z y) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (Either z (Maybe y)) -mapOptional arg0 arg1 = +mapOptional f m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.mapOptional")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.eithers.mapSet mapSet :: (Ord x, Ord y) => (Typed.TypedTerm (x -> Either z y) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (Either z (S.Set y))) -mapSet arg0 arg1 = +mapSet f s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.mapSet")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) --- | DSL reference to hydra.lib.eithers.partitionEithers -partitionEithers :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm ([x], [y]) -partitionEithers arg0 = +-- | DSL reference to hydra.lib.eithers.partition +partition :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm ([x], [y]) +partition xs = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.partitionEithers")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.partition")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.eithers.pure +pure :: Typed.TypedTerm y -> Typed.TypedTerm (Either x y) +pure x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.pure")), + Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL reference to hydra.lib.eithers.rights rights :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm [y] -rights arg0 = +rights xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.rights")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Equality.hs b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Equality.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -62,81 +64,20 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci --- | DSL reference to hydra.lib.equality.compare -compare :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Util.Comparison -compare arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.compare")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - -- | DSL reference to hydra.lib.equality.equal equal :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool -equal arg0 arg1 = +equal x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.equality.gt -gt :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool -gt arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.gt")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.equality.gte -gte :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool -gte arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.gte")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.equality.identity -identity :: Typed.TypedTerm x -> Typed.TypedTerm x -identity arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.identity")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.equality.lt -lt :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool -lt arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.lt")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.equality.lte -lte :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool -lte arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.lte")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.equality.max -max :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x -max arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.max")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) --- | DSL reference to hydra.lib.equality.min -min :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x -min arg0 arg1 = +-- | DSL reference to hydra.lib.equality.notEqual +notEqual :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool +notEqual x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.min")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.notEqual")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Functions.hs b/src/main/haskell/Hydra/Dsl/Lib/Functions.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Functions.hs @@ -0,0 +1,103 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.functions + +module Hydra.Dsl.Lib.Functions where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.lib.functions.compose +compose :: Typed.TypedTerm (t2 -> t3) -> Typed.TypedTerm (t1 -> t2) -> Typed.TypedTerm t1 -> Typed.TypedTerm t3 +compose g f x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.functions.compose")), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL reference to hydra.lib.functions.const +const :: Typed.TypedTerm t1 -> Typed.TypedTerm t2 -> Typed.TypedTerm t1 +const x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.functions.const")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.functions.flip +flip :: Typed.TypedTerm (t1 -> t2 -> t3) -> Typed.TypedTerm t2 -> Typed.TypedTerm t1 -> Typed.TypedTerm t3 +flip f x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.functions.flip")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.functions.identity +identity :: Typed.TypedTerm t1 -> Typed.TypedTerm t1 +identity x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.functions.identity")), + Core.applicationArgument = (Typed.unTypedTerm x)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Lists.hs b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Lists.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -61,312 +63,371 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +import qualified Data.Set as S -- | DSL reference to hydra.lib.lists.apply apply :: Typed.TypedTerm [x -> y] -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] -apply arg0 arg1 = +apply fs xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.apply")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm fs)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.at +at :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +at i xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.at")), + Core.applicationArgument = (Typed.unTypedTerm i)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.bind bind :: Typed.TypedTerm [x] -> Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm [y] -bind arg0 arg1 = +bind xs f = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.bind")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})), + Core.applicationArgument = (Typed.unTypedTerm f)})) +-- | DSL reference to hydra.lib.lists.compose +compose :: Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm (y -> [z]) -> Typed.TypedTerm x -> Typed.TypedTerm [z] +compose f g x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.compose")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL reference to hydra.lib.lists.concat concat :: Typed.TypedTerm [[x]] -> Typed.TypedTerm [x] -concat arg0 = +concat xss = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xss)})) -- | DSL reference to hydra.lib.lists.concat2 concat2 :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -concat2 arg0 arg1 = +concat2 xs ys = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})), + Core.applicationArgument = (Typed.unTypedTerm ys)})) -- | DSL reference to hydra.lib.lists.cons cons :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -cons arg0 arg1 = +cons x xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.distinct +distinct :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] +distinct xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.distinct")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.drop drop :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -drop arg0 arg1 = +drop n xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.drop")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm n)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.dropWhile dropWhile :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -dropWhile arg0 arg1 = +dropWhile p xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.dropWhile")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.lists.elem -elem :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm Bool -elem arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.elem")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.filter filter :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -filter arg0 arg1 = +filter p xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.filter")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.find find :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) -find arg0 arg1 = +find p xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.find")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.foldList +foldList :: Typed.TypedTerm (x -> y -> [x]) -> Typed.TypedTerm x -> Typed.TypedTerm [y] -> Typed.TypedTerm [x] +foldList f acc0 xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldList")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm acc0)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.foldl foldl :: Typed.TypedTerm (y -> x -> y) -> Typed.TypedTerm y -> Typed.TypedTerm [x] -> Typed.TypedTerm y -foldl arg0 arg1 arg2 = +foldl f acc0 xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm acc0)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.foldr foldr :: Typed.TypedTerm (x -> y -> y) -> Typed.TypedTerm y -> Typed.TypedTerm [x] -> Typed.TypedTerm y -foldr arg0 arg1 arg2 = +foldr f acc0 xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm acc0)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.group group :: Typed.TypedTerm [x] -> Typed.TypedTerm [[x]] -group arg0 = +group xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.group")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) --- | DSL reference to hydra.lib.lists.intercalate -intercalate :: Typed.TypedTerm [x] -> Typed.TypedTerm [[x]] -> Typed.TypedTerm [x] -intercalate arg0 arg1 = +-- | DSL reference to hydra.lib.lists.head +head :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +head xs = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.intercalate")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.head")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.init +init :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [x]) +init xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.init")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.intersperse intersperse :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -intersperse arg0 arg1 = +intersperse sep xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.intersperse")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm sep)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.join +join :: Typed.TypedTerm [x] -> Typed.TypedTerm [[x]] -> Typed.TypedTerm [x] +join sep xss = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.join")), + Core.applicationArgument = (Typed.unTypedTerm sep)})), + Core.applicationArgument = (Typed.unTypedTerm xss)})) + +-- | DSL reference to hydra.lib.lists.last +last :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +last xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.last")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.length length :: Typed.TypedTerm [x] -> Typed.TypedTerm Int -length arg0 = +length xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.length")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.map map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] -map arg0 arg1 = +map f xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) --- | DSL reference to hydra.lib.lists.maybeAt -maybeAt :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) -maybeAt arg0 arg1 = +-- | DSL reference to hydra.lib.lists.mapList +mapList :: Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm [x] -> Typed.TypedTerm [[y]] +mapList f xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeAt")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.lists.maybeHead -maybeHead :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) -maybeHead arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeHead")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.lists.maybeInit -maybeInit :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [x]) -maybeInit arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeInit")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.mapList")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) --- | DSL reference to hydra.lib.lists.maybeLast -maybeLast :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) -maybeLast arg0 = +-- | DSL reference to hydra.lib.lists.mapOptional +mapOptional :: Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm [Maybe y] +mapOptional f m = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeLast")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.mapOptional")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) --- | DSL reference to hydra.lib.lists.maybeTail -maybeTail :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [x]) -maybeTail arg0 = +-- | DSL reference to hydra.lib.lists.mapSet +mapSet :: (Ord x, Ord y) => (Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm [S.Set y]) +mapSet f s = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeTail")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.mapSet")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) --- | DSL reference to hydra.lib.lists.nub -nub :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] -nub arg0 = +-- | DSL reference to hydra.lib.lists.member +member :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm Bool +member x xs = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.nub")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.member")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.null null :: Typed.TypedTerm [x] -> Typed.TypedTerm Bool -null arg0 = +null xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.null")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.partition partition :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm ([x], [x]) -partition arg0 arg1 = +partition p xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.partition")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.pure pure :: Typed.TypedTerm x -> Typed.TypedTerm [x] -pure arg0 = +pure x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.pure")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.lists.replicate replicate :: Typed.TypedTerm Int -> Typed.TypedTerm x -> Typed.TypedTerm [x] -replicate arg0 arg1 = +replicate n x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.replicate")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm n)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.lists.reverse reverse :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] -reverse arg0 = +reverse xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.reverse")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.singleton singleton :: Typed.TypedTerm x -> Typed.TypedTerm [x] -singleton arg0 = +singleton x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.singleton")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.lists.sort sort :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] -sort arg0 = +sort xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.sort")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) --- | DSL reference to hydra.lib.lists.sortOn -sortOn :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -sortOn arg0 arg1 = +-- | DSL reference to hydra.lib.lists.sortBy +sortBy :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +sortBy f xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.sortOn")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.sortBy")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.span span :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm ([x], [x]) -span arg0 arg1 = +span p xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.span")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.tail +tail :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [x]) +tail xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.tail")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.take take :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] -take arg0 arg1 = +take n xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.take")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm n)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.lists.takeWhile +takeWhile :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +takeWhile p xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.takeWhile")), + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.lists.transpose transpose :: Typed.TypedTerm [[x]] -> Typed.TypedTerm [[x]] -transpose arg0 = +transpose xss = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.transpose")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xss)})) -- | DSL reference to hydra.lib.lists.uncons uncons :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe (x, [x])) -uncons arg0 = +uncons xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.uncons")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.lists.zip zip :: Typed.TypedTerm [x] -> Typed.TypedTerm [y] -> Typed.TypedTerm [(x, y)] -zip arg0 arg1 = +zip xs ys = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.zip")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})), + Core.applicationArgument = (Typed.unTypedTerm ys)})) -- | DSL reference to hydra.lib.lists.zipWith zipWith :: Typed.TypedTerm (x -> y -> z) -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] -> Typed.TypedTerm [z] -zipWith arg0 arg1 arg2 = +zipWith f xs ys = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.zipWith")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})), + Core.applicationArgument = (Typed.unTypedTerm ys)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Literals.hs b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Literals.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,387 +66,387 @@ import qualified Data.ByteString as B import qualified Data.Int as I +-- | DSL reference to hydra.lib.literals.base64ToBinary +base64ToBinary :: Typed.TypedTerm String -> Typed.TypedTerm B.ByteString +base64ToBinary s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.base64ToBinary")), + Core.applicationArgument = (Typed.unTypedTerm s)})) + -- | DSL reference to hydra.lib.literals.bigintToDecimal bigintToDecimal :: Typed.TypedTerm Integer -> Typed.TypedTerm Sci.Scientific -bigintToDecimal arg0 = +bigintToDecimal x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToDecimal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToInt16 bigintToInt16 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int16 -bigintToInt16 arg0 = +bigintToInt16 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToInt32 bigintToInt32 :: Typed.TypedTerm Integer -> Typed.TypedTerm Int -bigintToInt32 arg0 = +bigintToInt32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToInt64 bigintToInt64 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int64 -bigintToInt64 arg0 = +bigintToInt64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToInt8 bigintToInt8 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int8 -bigintToInt8 arg0 = +bigintToInt8 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToUint16 bigintToUint16 :: Typed.TypedTerm Integer -> Typed.TypedTerm Int -bigintToUint16 arg0 = +bigintToUint16 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToUint32 bigintToUint32 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int64 -bigintToUint32 arg0 = +bigintToUint32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToUint64 bigintToUint64 :: Typed.TypedTerm Integer -> Typed.TypedTerm Integer -bigintToUint64 arg0 = +bigintToUint64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.bigintToUint8 bigintToUint8 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int16 -bigintToUint8 arg0 = +bigintToUint8 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL reference to hydra.lib.literals.binaryToBase64 +binaryToBase64 :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm String +binaryToBase64 b = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.binaryToBase64")), + Core.applicationArgument = (Typed.unTypedTerm b)})) + -- | DSL reference to hydra.lib.literals.binaryToBytes binaryToBytes :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm [Int] -binaryToBytes arg0 = +binaryToBytes b = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.binaryToBytes")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.binaryToString -binaryToString :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm String -binaryToString arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.binaryToString")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm b)})) -- | DSL reference to hydra.lib.literals.decimalToBigint decimalToBigint :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Integer -decimalToBigint arg0 = +decimalToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.decimalToFloat32 decimalToFloat32 :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Float -decimalToFloat32 arg0 = +decimalToFloat32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToFloat32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.decimalToFloat64 decimalToFloat64 :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Double -decimalToFloat64 arg0 = +decimalToFloat64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.float32ToDecimal float32ToDecimal :: Typed.TypedTerm Float -> Typed.TypedTerm Sci.Scientific -float32ToDecimal arg0 = +float32ToDecimal x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float32ToDecimal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.float32ToFloat64 float32ToFloat64 :: Typed.TypedTerm Float -> Typed.TypedTerm Double -float32ToFloat64 arg0 = +float32ToFloat64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float32ToFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.float64ToDecimal float64ToDecimal :: Typed.TypedTerm Double -> Typed.TypedTerm Sci.Scientific -float64ToDecimal arg0 = +float64ToDecimal x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float64ToDecimal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.float64ToFloat32 float64ToFloat32 :: Typed.TypedTerm Double -> Typed.TypedTerm Float -float64ToFloat32 arg0 = +float64ToFloat32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float64ToFloat32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.int16ToBigint int16ToBigint :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Integer -int16ToBigint arg0 = +int16ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int16ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.int32ToBigint int32ToBigint :: Typed.TypedTerm Int -> Typed.TypedTerm Integer -int32ToBigint arg0 = +int32ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int32ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.int64ToBigint int64ToBigint :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Integer -int64ToBigint arg0 = +int64ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int64ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.int8ToBigint int8ToBigint :: Typed.TypedTerm I.Int8 -> Typed.TypedTerm Integer -int8ToBigint arg0 = +int8ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int8ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL reference to hydra.lib.literals.parseBoolean +parseBoolean :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Bool) +parseBoolean s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.parseBoolean")), + Core.applicationArgument = (Typed.unTypedTerm s)})) + +-- | DSL reference to hydra.lib.literals.parseString +parseString :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe String) +parseString s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.parseString")), + Core.applicationArgument = (Typed.unTypedTerm s)})) + +-- | DSL reference to hydra.lib.literals.printBoolean +printBoolean :: Typed.TypedTerm Bool -> Typed.TypedTerm String +printBoolean b = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.printBoolean")), + Core.applicationArgument = (Typed.unTypedTerm b)})) + +-- | DSL reference to hydra.lib.literals.printString +printString :: Typed.TypedTerm String -> Typed.TypedTerm String +printString s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.printString")), + Core.applicationArgument = (Typed.unTypedTerm s)})) + -- | DSL reference to hydra.lib.literals.readBigint readBigint :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Integer) -readBigint arg0 = +readBigint s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.readBoolean -readBoolean :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Bool) -readBoolean arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readBoolean")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readDecimal readDecimal :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Sci.Scientific) -readDecimal arg0 = +readDecimal s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readDecimal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readFloat32 readFloat32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Float) -readFloat32 arg0 = +readFloat32 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readFloat32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readFloat64 readFloat64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Double) -readFloat64 arg0 = +readFloat64 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readInt16 readInt16 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int16) -readInt16 arg0 = +readInt16 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readInt32 readInt32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) -readInt32 arg0 = +readInt32 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readInt64 readInt64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int64) -readInt64 arg0 = +readInt64 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readInt8 readInt8 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int8) -readInt8 arg0 = +readInt8 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.readString -readString :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe String) -readString arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readString")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readUint16 readUint16 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) -readUint16 arg0 = +readUint16 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readUint32 readUint32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int64) -readUint32 arg0 = +readUint32 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readUint64 readUint64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Integer) -readUint64 arg0 = +readUint64 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.readUint8 readUint8 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int16) -readUint8 arg0 = +readUint8 s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.literals.showBigint showBigint :: Typed.TypedTerm Integer -> Typed.TypedTerm String -showBigint arg0 = +showBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.showBoolean -showBoolean :: Typed.TypedTerm Bool -> Typed.TypedTerm String -showBoolean arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showBoolean")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showDecimal showDecimal :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm String -showDecimal arg0 = +showDecimal x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showDecimal")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showFloat32 showFloat32 :: Typed.TypedTerm Float -> Typed.TypedTerm String -showFloat32 arg0 = +showFloat32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showFloat32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showFloat64 showFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm String -showFloat64 arg0 = +showFloat64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showInt16 showInt16 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm String -showInt16 arg0 = +showInt16 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showInt32 showInt32 :: Typed.TypedTerm Int -> Typed.TypedTerm String -showInt32 arg0 = +showInt32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showInt64 showInt64 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm String -showInt64 arg0 = +showInt64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showInt8 showInt8 :: Typed.TypedTerm I.Int8 -> Typed.TypedTerm String -showInt8 arg0 = +showInt8 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.showString -showString :: Typed.TypedTerm String -> Typed.TypedTerm String -showString arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showString")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showUint16 showUint16 :: Typed.TypedTerm Int -> Typed.TypedTerm String -showUint16 arg0 = +showUint16 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint16")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showUint32 showUint32 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm String -showUint32 arg0 = +showUint32 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showUint64 showUint64 :: Typed.TypedTerm Integer -> Typed.TypedTerm String -showUint64 arg0 = +showUint64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.showUint8 showUint8 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm String -showUint8 arg0 = +showUint8 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint8")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.literals.stringToBinary -stringToBinary :: Typed.TypedTerm String -> Typed.TypedTerm B.ByteString -stringToBinary arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.stringToBinary")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.uint16ToBigint uint16ToBigint :: Typed.TypedTerm Int -> Typed.TypedTerm Integer -uint16ToBigint arg0 = +uint16ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint16ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.uint32ToBigint uint32ToBigint :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Integer -uint32ToBigint arg0 = +uint32ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint32ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.uint64ToBigint uint64ToBigint :: Typed.TypedTerm Integer -> Typed.TypedTerm Integer -uint64ToBigint arg0 = +uint64ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint64ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.literals.uint8ToBigint uint8ToBigint :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Integer -uint8ToBigint arg0 = +uint8ToBigint x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint8ToBigint")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Logic.hs b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Logic.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,36 +66,36 @@ -- | DSL reference to hydra.lib.logic.and and :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -and arg0 arg1 = +and p q = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.and")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm q)})) -- | DSL reference to hydra.lib.logic.ifElse ifElse :: Typed.TypedTerm Bool -> Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x -ifElse arg0 arg1 arg2 = +ifElse p t f = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm t)})), + Core.applicationArgument = (Typed.unTypedTerm f)})) -- | DSL reference to hydra.lib.logic.not not :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -not arg0 = +not p = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.not")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm p)})) -- | DSL reference to hydra.lib.logic.or or :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -or arg0 arg1 = +or p q = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.or")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm q)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Maps.hs b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Maps.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -65,41 +67,50 @@ -- | DSL reference to hydra.lib.maps.alter alter :: Ord k => (Typed.TypedTerm (Maybe v -> Maybe v) -> Typed.TypedTerm k -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -alter arg0 arg1 arg2 = +alter f k m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.alter")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.bimap bimap :: (Ord k1, Ord k2) => (Typed.TypedTerm (k1 -> k2) -> Typed.TypedTerm (v1 -> v2) -> Typed.TypedTerm (M.Map k1 v1) -> Typed.TypedTerm (M.Map k2 v2)) -bimap arg0 arg1 arg2 = +bimap fk fv m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.bimap")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm fk)})), + Core.applicationArgument = (Typed.unTypedTerm fv)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.delete delete :: Ord k => (Typed.TypedTerm k -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -delete arg0 arg1 = +delete k m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.delete")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) +-- | DSL reference to hydra.lib.maps.difference +difference :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) +difference m1 m2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.difference")), + Core.applicationArgument = (Typed.unTypedTerm m1)})), + Core.applicationArgument = (Typed.unTypedTerm m2)})) + -- | DSL reference to hydra.lib.maps.elems elems :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [v]) -elems arg0 = +elems m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.elems")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.empty empty :: Ord k => (Typed.TypedTerm (M.Map k v)) @@ -107,129 +118,145 @@ -- | DSL reference to hydra.lib.maps.filter filter :: Ord k => (Typed.TypedTerm (v -> Bool) -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -filter arg0 arg1 = +filter p m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.filter")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.filterWithKey filterWithKey :: Ord k => (Typed.TypedTerm (k -> v -> Bool) -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -filterWithKey arg0 arg1 = +filterWithKey p m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.filterWithKey")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm p)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.findWithDefault findWithDefault :: Ord k => (Typed.TypedTerm v -> Typed.TypedTerm k -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm v) -findWithDefault arg0 arg1 arg2 = +findWithDefault def k m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.findWithDefault")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm def)})), + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.fromList fromList :: Ord k => (Typed.TypedTerm [(k, v)] -> Typed.TypedTerm (M.Map k v)) -fromList arg0 = +fromList xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.maps.insert insert :: Ord k => (Typed.TypedTerm k -> Typed.TypedTerm v -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -insert arg0 arg1 arg2 = +insert k v m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.insert")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm v)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) +-- | DSL reference to hydra.lib.maps.intersection +intersection :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) +intersection m1 m2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.intersection")), + Core.applicationArgument = (Typed.unTypedTerm m1)})), + Core.applicationArgument = (Typed.unTypedTerm m2)})) + -- | DSL reference to hydra.lib.maps.keys keys :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [k]) -keys arg0 = +keys m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.keys")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.lookup lookup :: Ord k => (Typed.TypedTerm k -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (Maybe v)) -lookup arg0 arg1 = +lookup k m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.lookup")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.map map :: Ord k => (Typed.TypedTerm (v1 -> v2) -> Typed.TypedTerm (M.Map k v1) -> Typed.TypedTerm (M.Map k v2)) -map arg0 arg1 = +map f m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.map")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.mapKeys mapKeys :: (Ord k1, Ord k2) => (Typed.TypedTerm (k1 -> k2) -> Typed.TypedTerm (M.Map k1 v) -> Typed.TypedTerm (M.Map k2 v)) -mapKeys arg0 arg1 = +mapKeys f m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.mapKeys")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.member member :: Ord k => (Typed.TypedTerm k -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm Bool) -member arg0 arg1 = +member k m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.member")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.null null :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm Bool) -null arg0 = +null m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.null")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.singleton singleton :: Ord k => (Typed.TypedTerm k -> Typed.TypedTerm v -> Typed.TypedTerm (M.Map k v)) -singleton arg0 arg1 = +singleton k v = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.singleton")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm k)})), + Core.applicationArgument = (Typed.unTypedTerm v)})) -- | DSL reference to hydra.lib.maps.size size :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm Int) -size arg0 = +size m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.size")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.toList toList :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [(k, v)]) -toList arg0 = +toList m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.maps.union union :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm (M.Map k v)) -union arg0 arg1 = +union m1 m2 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.union")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm m1)})), + Core.applicationArgument = (Typed.unTypedTerm m2)})) + +-- | DSL reference to hydra.lib.maps.unions +unions :: Ord k => (Typed.TypedTerm [M.Map k v] -> Typed.TypedTerm (M.Map k v)) +unions ms = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.unions")), + Core.applicationArgument = (Typed.unTypedTerm ms)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Math.hs b/src/main/haskell/Hydra/Dsl/Lib/Math.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Math.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Math.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,27 +66,27 @@ -- | DSL reference to hydra.lib.math.abs abs :: Typed.TypedTerm Int -> Typed.TypedTerm Int -abs arg0 = +abs x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.abs")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.acos acos :: Typed.TypedTerm Double -> Typed.TypedTerm Double -acos arg0 = +acos x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.acos")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.acosh acosh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -acosh arg0 = +acosh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.acosh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.add -add :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +add :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x add arg0 arg1 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { @@ -94,173 +96,132 @@ -- | DSL reference to hydra.lib.math.addFloat64 addFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -addFloat64 arg0 arg1 = +addFloat64 x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.addFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) -- | DSL reference to hydra.lib.math.asin asin :: Typed.TypedTerm Double -> Typed.TypedTerm Double -asin arg0 = +asin x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.asin")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.asinh asinh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -asinh arg0 = +asinh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.asinh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.atan atan :: Typed.TypedTerm Double -> Typed.TypedTerm Double -atan arg0 = +atan x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.atan")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.atan2 atan2 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -atan2 arg0 arg1 = +atan2 y x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.atan2")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm y)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.atanh atanh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -atanh arg0 = +atanh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.atanh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.ceiling ceiling :: Typed.TypedTerm Double -> Typed.TypedTerm Double -ceiling arg0 = +ceiling x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.ceiling")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.cos cos :: Typed.TypedTerm Double -> Typed.TypedTerm Double -cos arg0 = +cos x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.cos")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.cosh cosh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -cosh arg0 = +cosh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.cosh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL reference to hydra.lib.math.div +div :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) +div x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.div")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + -- | DSL reference to hydra.lib.math.e e :: Typed.TypedTerm Double e = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.math.e")) -- | DSL reference to hydra.lib.math.even even :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -even arg0 = +even x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.even")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.exp exp :: Typed.TypedTerm Double -> Typed.TypedTerm Double -exp arg0 = +exp x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.exp")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.floor floor :: Typed.TypedTerm Double -> Typed.TypedTerm Double -floor arg0 = +floor x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.floor")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.log log :: Typed.TypedTerm Double -> Typed.TypedTerm Double -log arg0 = +log x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.log")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.logBase logBase :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -logBase arg0 arg1 = +logBase b x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.logBase")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.math.max -max :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int -max arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.max")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.math.maybeDiv -maybeDiv :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) -maybeDiv arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeDiv")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.math.maybeMod -maybeMod :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) -maybeMod arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeMod")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.math.maybePred -maybePred :: Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) -maybePred arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybePred")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.math.maybeRem -maybeRem :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) -maybeRem arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeRem")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) - --- | DSL reference to hydra.lib.math.maybeSucc -maybeSucc :: Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) -maybeSucc arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeSucc")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm b)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) --- | DSL reference to hydra.lib.math.min -min :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int -min arg0 arg1 = +-- | DSL reference to hydra.lib.math.mod +mod :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) +mod x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.min")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mod")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) -- | DSL reference to hydra.lib.math.mul -mul :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +mul :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x mul arg0 arg1 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { @@ -270,15 +231,15 @@ -- | DSL reference to hydra.lib.math.mulFloat64 mulFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -mulFloat64 arg0 arg1 = +mulFloat64 x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mulFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) -- | DSL reference to hydra.lib.math.negate -negate :: Typed.TypedTerm Int -> Typed.TypedTerm Int +negate :: Typed.TypedTerm x -> Typed.TypedTerm x negate arg0 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.negate")), @@ -286,17 +247,17 @@ -- | DSL reference to hydra.lib.math.negateFloat64 negateFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -negateFloat64 arg0 = +negateFloat64 x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.negateFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.odd odd :: Typed.TypedTerm Int -> Typed.TypedTerm Bool -odd arg0 = +odd x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.odd")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.pi pi :: Typed.TypedTerm Double @@ -304,77 +265,86 @@ -- | DSL reference to hydra.lib.math.pow pow :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -pow arg0 arg1 = +pow x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.pow")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) -- | DSL reference to hydra.lib.math.range range :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm [Int] -range arg0 arg1 = +range a b = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.range")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm a)})), + Core.applicationArgument = (Typed.unTypedTerm b)})) +-- | DSL reference to hydra.lib.math.rem +rem :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int) +rem x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.rem")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + -- | DSL reference to hydra.lib.math.round round :: Typed.TypedTerm Double -> Typed.TypedTerm Double -round arg0 = +round x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.round")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.roundFloat32 roundFloat32 :: Typed.TypedTerm Int -> Typed.TypedTerm Float -> Typed.TypedTerm Float -roundFloat32 arg0 arg1 = +roundFloat32 n x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.roundFloat32")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm n)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.roundFloat64 roundFloat64 :: Typed.TypedTerm Int -> Typed.TypedTerm Double -> Typed.TypedTerm Double -roundFloat64 arg0 arg1 = +roundFloat64 n x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.roundFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm n)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.signum signum :: Typed.TypedTerm Int -> Typed.TypedTerm Int -signum arg0 = +signum x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.signum")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.sin sin :: Typed.TypedTerm Double -> Typed.TypedTerm Double -sin arg0 = +sin x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sin")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.sinh sinh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -sinh arg0 = +sinh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sinh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.sqrt sqrt :: Typed.TypedTerm Double -> Typed.TypedTerm Double -sqrt arg0 = +sqrt x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sqrt")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.sub -sub :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +sub :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x sub arg0 arg1 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { @@ -384,30 +354,30 @@ -- | DSL reference to hydra.lib.math.subFloat64 subFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double -subFloat64 arg0 arg1 = +subFloat64 x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.subFloat64")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) -- | DSL reference to hydra.lib.math.tan tan :: Typed.TypedTerm Double -> Typed.TypedTerm Double -tan arg0 = +tan x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.tan")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.tanh tanh :: Typed.TypedTerm Double -> Typed.TypedTerm Double -tanh arg0 = +tanh x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.tanh")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.truncate truncate :: Typed.TypedTerm Double -> Typed.TypedTerm Double -truncate arg0 = +truncate x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.truncate")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -61,105 +63,135 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +import qualified Data.Set as S -- | DSL reference to hydra.lib.optionals.apply apply :: Typed.TypedTerm (Maybe (x -> y)) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (Maybe y) -apply arg0 arg1 = +apply mf mx = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.apply")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm mf)})), + Core.applicationArgument = (Typed.unTypedTerm mx)})) -- | DSL reference to hydra.lib.optionals.bind bind :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm (Maybe y) -bind arg0 arg1 = +bind m f = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm m)})), + Core.applicationArgument = (Typed.unTypedTerm f)})) -- | DSL reference to hydra.lib.optionals.cases cases :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm y -> Typed.TypedTerm (x -> y) -> Typed.TypedTerm y -cases arg0 arg1 arg2 = +cases m def f = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) - --- | DSL reference to hydra.lib.optionals.cat -cat :: Typed.TypedTerm [Maybe x] -> Typed.TypedTerm [x] -cat arg0 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cat")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})), + Core.applicationArgument = (Typed.unTypedTerm def)})), + Core.applicationArgument = (Typed.unTypedTerm f)})) -- | DSL reference to hydra.lib.optionals.compose compose :: Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm (y -> Maybe z) -> Typed.TypedTerm x -> Typed.TypedTerm (Maybe z) -compose arg0 arg1 arg2 = +compose f g x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.compose")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm x)})) --- | DSL reference to hydra.lib.optionals.fromOptional -fromOptional :: Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm x -fromOptional arg0 arg1 = +-- | DSL reference to hydra.lib.optionals.foldList +foldList :: Typed.TypedTerm (x -> y -> Maybe x) -> Typed.TypedTerm x -> Typed.TypedTerm [y] -> Typed.TypedTerm (Maybe x) +foldList f acc xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.fromOptional")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.foldList")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm acc)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.optionals.givens +givens :: Typed.TypedTerm [Maybe x] -> Typed.TypedTerm [x] +givens xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.givens")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.optionals.isGiven isGiven :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm Bool -isGiven arg0 = +isGiven m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.isGiven")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.optionals.isNone isNone :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm Bool -isNone arg0 = +isNone m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.isNone")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) -- | DSL reference to hydra.lib.optionals.map map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (Maybe y) -map arg0 arg1 = +map f m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) +-- | DSL reference to hydra.lib.optionals.mapList +mapList :: Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [y]) +mapList f xs = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.mapList")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + -- | DSL reference to hydra.lib.optionals.mapOptional mapOptional :: Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] -mapOptional arg0 arg1 = +mapOptional f xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.mapOptional")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) +-- | DSL reference to hydra.lib.optionals.mapSet +mapSet :: (Ord x, Ord y) => (Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (Maybe (S.Set y))) +mapSet f s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.mapSet")), + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) + -- | DSL reference to hydra.lib.optionals.pure pure :: Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) -pure arg0 = +pure x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.optionals.toList toList :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm [x] -toList arg0 = +toList m = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.toList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm m)})) + +-- | DSL reference to hydra.lib.optionals.withDefault +withDefault :: Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm x +withDefault def m = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")), + Core.applicationArgument = (Typed.unTypedTerm def)})), + Core.applicationArgument = (Typed.unTypedTerm m)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Ordering.hs b/src/main/haskell/Hydra/Dsl/Lib/Ordering.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Ordering.hs @@ -0,0 +1,128 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.ordering + +module Hydra.Dsl.Lib.Ordering where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.lib.ordering.compare +compare :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Util.Comparison +compare x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.compare")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.gt +gt :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool +gt x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.gt")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.gte +gte :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool +gte x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.gte")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.lt +lt :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool +lt x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.lt")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.lte +lte :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm Bool +lte x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.lte")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.max +max :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x +max x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.max")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) + +-- | DSL reference to hydra.lib.ordering.min +min :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x +min x y = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.min")), + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm y)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs b/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,25 +66,25 @@ -- | DSL reference to hydra.lib.pairs.bimap bimap :: Typed.TypedTerm (a -> c) -> Typed.TypedTerm (b -> d) -> Typed.TypedTerm (a, b) -> Typed.TypedTerm (c, d) -bimap arg0 arg1 arg2 = +bimap f g p = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.bimap")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm g)})), + Core.applicationArgument = (Typed.unTypedTerm p)})) -- | DSL reference to hydra.lib.pairs.first first :: Typed.TypedTerm (a, b) -> Typed.TypedTerm a -first arg0 = +first p = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm p)})) -- | DSL reference to hydra.lib.pairs.second second :: Typed.TypedTerm (a, b) -> Typed.TypedTerm b -second arg0 = +second p = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm p)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Regex.hs b/src/main/haskell/Hydra/Dsl/Lib/Regex.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Regex.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Regex.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,58 +66,58 @@ -- | DSL reference to hydra.lib.regex.find find :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm (Maybe String) -find arg0 arg1 = +find pat s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.find")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.regex.findAll findAll :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] -findAll arg0 arg1 = +findAll pat s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.findAll")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.regex.matches matches :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Bool -matches arg0 arg1 = +matches pat s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.matches")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.regex.replace replace :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -replace arg0 arg1 arg2 = +replace pat repl s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.replace")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm repl)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.regex.replaceAll replaceAll :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -replaceAll arg0 arg1 arg2 = +replaceAll pat repl s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.replaceAll")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})), - Core.applicationArgument = (Typed.unTypedTerm arg2)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm repl)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.regex.split split :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] -split arg0 arg1 = +split pat s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.regex.split")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm pat)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Sets.hs b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Sets.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -65,109 +67,118 @@ -- | DSL reference to hydra.lib.sets.delete delete :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) -delete arg0 arg1 = +delete x s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.delete")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.difference difference :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) -difference arg0 arg1 = +difference s1 s2 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.difference")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm s1)})), + Core.applicationArgument = (Typed.unTypedTerm s2)})) -- | DSL reference to hydra.lib.sets.empty empty :: Ord x => (Typed.TypedTerm (S.Set x)) empty = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.sets.empty")) +-- | DSL reference to hydra.lib.sets.filter +filter :: Ord x => (Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) +filter predicate s = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.filter")), + Core.applicationArgument = (Typed.unTypedTerm predicate)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) + -- | DSL reference to hydra.lib.sets.fromList fromList :: Ord x => (Typed.TypedTerm [x] -> Typed.TypedTerm (S.Set x)) -fromList arg0 = +fromList xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.sets.insert insert :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) -insert arg0 arg1 = +insert x s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.insert")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.intersection intersection :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) -intersection arg0 arg1 = +intersection s1 s2 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.intersection")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm s1)})), + Core.applicationArgument = (Typed.unTypedTerm s2)})) -- | DSL reference to hydra.lib.sets.map map :: (Ord x, Ord y) => (Typed.TypedTerm (x -> y) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set y)) -map arg0 arg1 = +map f s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.map")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm f)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.member member :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Bool) -member arg0 arg1 = +member x s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.member")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm x)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.null null :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Bool) -null arg0 = +null s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.null")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.singleton singleton :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x)) -singleton arg0 = +singleton x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.singleton")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.sets.size size :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Int) -size arg0 = +size s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.size")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.toList toList :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm [x]) -toList arg0 = +toList s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.sets.union union :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) -union arg0 arg1 = +union s1 s2 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.union")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm s1)})), + Core.applicationArgument = (Typed.unTypedTerm s2)})) -- | DSL reference to hydra.lib.sets.unions unions :: Ord x => (Typed.TypedTerm [S.Set x] -> Typed.TypedTerm (S.Set x)) -unions arg0 = +unions ss = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.unions")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm ss)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Strings.hs b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Strings.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs @@ -25,6 +25,7 @@ import qualified Hydra.Dsl.Parsing as DslParsing import qualified Hydra.Dsl.Paths as DslPaths import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular @@ -48,6 +49,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -62,101 +64,101 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci --- | DSL reference to hydra.lib.strings.cat -cat :: Typed.TypedTerm [String] -> Typed.TypedTerm String -cat arg0 = +-- | DSL reference to hydra.lib.strings.charAt +charAt :: Typed.TypedTerm Int -> Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) +charAt i s = Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.cat")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.charAt")), + Core.applicationArgument = (Typed.unTypedTerm i)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) --- | DSL reference to hydra.lib.strings.cat2 -cat2 :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -cat2 arg0 arg1 = +-- | DSL reference to hydra.lib.strings.concat +concat :: Typed.TypedTerm [String] -> Typed.TypedTerm String +concat xs = Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.concat")), + Core.applicationArgument = (Typed.unTypedTerm xs)})) + +-- | DSL reference to hydra.lib.strings.concat2 +concat2 :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String +concat2 s t = + Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.cat2")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.concat2")), + Core.applicationArgument = (Typed.unTypedTerm s)})), + Core.applicationArgument = (Typed.unTypedTerm t)})) -- | DSL reference to hydra.lib.strings.fromList fromList :: Typed.TypedTerm [Int] -> Typed.TypedTerm String -fromList arg0 = +fromList cs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.fromList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm cs)})) --- | DSL reference to hydra.lib.strings.intercalate -intercalate :: Typed.TypedTerm String -> Typed.TypedTerm [String] -> Typed.TypedTerm String -intercalate arg0 arg1 = +-- | DSL reference to hydra.lib.strings.join +join :: Typed.TypedTerm String -> Typed.TypedTerm [String] -> Typed.TypedTerm String +join sep xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.intercalate")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.join")), + Core.applicationArgument = (Typed.unTypedTerm sep)})), + Core.applicationArgument = (Typed.unTypedTerm xs)})) -- | DSL reference to hydra.lib.strings.length length :: Typed.TypedTerm String -> Typed.TypedTerm Int -length arg0 = +length s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.length")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.lines lines :: Typed.TypedTerm String -> Typed.TypedTerm [String] -lines arg0 = +lines s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.lines")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) - --- | DSL reference to hydra.lib.strings.maybeCharAt -maybeCharAt :: Typed.TypedTerm Int -> Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) -maybeCharAt arg0 arg1 = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.maybeCharAt")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.null null :: Typed.TypedTerm String -> Typed.TypedTerm Bool -null arg0 = +null s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.null")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.splitOn splitOn :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] -splitOn arg0 arg1 = +splitOn sep s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.splitOn")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})), - Core.applicationArgument = (Typed.unTypedTerm arg1)})) + Core.applicationArgument = (Typed.unTypedTerm sep)})), + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.toList toList :: Typed.TypedTerm String -> Typed.TypedTerm [Int] -toList arg0 = +toList s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toList")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.toLower toLower :: Typed.TypedTerm String -> Typed.TypedTerm String -toLower arg0 = +toLower s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toLower")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.toUpper toUpper :: Typed.TypedTerm String -> Typed.TypedTerm String -toUpper arg0 = +toUpper s = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toUpper")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm s)})) -- | DSL reference to hydra.lib.strings.unlines unlines :: Typed.TypedTerm [String] -> Typed.TypedTerm String -unlines arg0 = +unlines xs = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.unlines")), - Core.applicationArgument = (Typed.unTypedTerm arg0)})) + Core.applicationArgument = (Typed.unTypedTerm xs)})) diff --git a/src/main/haskell/Hydra/Dsl/Names.hs b/src/main/haskell/Hydra/Dsl/Names.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Names.hs @@ -0,0 +1,231 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.names + +module Hydra.Dsl.Names where + +import qualified Hydra.Annotations as Annotations +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Annotations as DslAnnotations +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Formatting as DslFormatting +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +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.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.names.chooseUniqueLabel +chooseUniqueLabel :: Typed.TypedTerm (S.Set String) -> Typed.TypedTerm String -> Typed.TypedTerm String +chooseUniqueLabel arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.chooseUniqueLabel")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.compactName +compactName :: Typed.TypedTerm (M.Map Packaging.ModuleName String) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm String +compactName arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.compactName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.derivedBindingName +derivedBindingName :: Typed.TypedTerm [String] -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name +derivedBindingName arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.derivedBindingName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.names.derivedDefinitionName +derivedDefinitionName :: Typed.TypedTerm [String] -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Name -> Typed.TypedTerm String -> Typed.TypedTerm Core.Name +derivedDefinitionName arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.derivedDefinitionName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) + +-- | DSL reference to hydra.names.derivedModuleName +derivedModuleName :: Typed.TypedTerm [String] -> Typed.TypedTerm Bool -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.ModuleName +derivedModuleName arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.derivedModuleName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.names.freshName +freshName :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (Core.Name, Typing.InferenceContext) +freshName arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.freshName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.names.freshNames +freshNames :: Typed.TypedTerm Int -> Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm ([Core.Name], Typing.InferenceContext) +freshNames arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.freshNames")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.localNameOf +localNameOf :: Typed.TypedTerm Core.Name -> Typed.TypedTerm String +localNameOf arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.localNameOf")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.names.moduleNameOf +moduleNameOf :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Packaging.ModuleName) +moduleNameOf arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.moduleNameOf")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.names.moduleNameToFilePath +moduleNameToFilePath :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm File.FileExtension -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm String +moduleNameToFilePath arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.moduleNameToFilePath")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.names.nameToFilePath +nameToFilePath :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm File.FileExtension -> Typed.TypedTerm Core.Name -> Typed.TypedTerm String +nameToFilePath arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.nameToFilePath")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.names.normalTypeVariable +normalTypeVariable :: Typed.TypedTerm Int -> Typed.TypedTerm Core.Name +normalTypeVariable arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.normalTypeVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.names.pushSubtermStep +pushSubtermStep :: Typed.TypedTerm Paths.SubtermStep -> Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Typing.InferenceContext +pushSubtermStep arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.pushSubtermStep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.qname +qname :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm String -> Typed.TypedTerm Core.Name +qname arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.qname")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.qualifyName +qualifyName :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Util.QualifiedName +qualifyName arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.qualifyName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.names.restoreTrace +restoreTrace :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Typing.InferenceContext +restoreTrace arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.restoreTrace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.names.unqualifyName +unqualifyName :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm Core.Name +unqualifyName arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.names.unqualifyName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Packaging.hs b/src/main/haskell/Hydra/Dsl/Packaging.hs --- a/src/main/haskell/Hydra/Dsl/Packaging.hs +++ b/src/main/haskell/Hydra/Dsl/Packaging.hs @@ -5,14 +5,20 @@ module Hydra.Dsl.Packaging where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Packaging as DecodePackaging import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Encode.Packaging as EncodePackaging import qualified Hydra.Packaging as Packaging import qualified Hydra.Typed as Typed import qualified Hydra.Typing as Typing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +-- | DSL name token for hydra.packaging.Definition +definitionDefinition :: Typed.TypedName Packaging.Definition +definitionDefinition = Typed.TypedName (Core.Name "hydra.packaging.Definition") + -- | DSL injection for the primitive variant of hydra.packaging.Definition definitionPrimitive :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Packaging.Definition definitionPrimitive x = @@ -22,6 +28,10 @@ Core.fieldName = (Core.Name "primitive"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.packaging.DefinitionReference +definitionReferenceDefinitionReference :: Typed.TypedName Packaging.DefinitionReference +definitionReferenceDefinitionReference = Typed.TypedName (Core.Name "hydra.packaging.DefinitionReference") + -- | DSL injection for the primitive variant of hydra.packaging.DefinitionReference definitionReferencePrimitive :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.DefinitionReference definitionReferencePrimitive x = @@ -76,6 +86,10 @@ Core.fieldName = (Core.Name "api"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.packaging.DependencyScope +dependencyScopeDependencyScope :: Typed.TypedName Packaging.DependencyScope +dependencyScopeDependencyScope = Typed.TypedName (Core.Name "hydra.packaging.DependencyScope") + -- | DSL injection for the runtime variant of hydra.packaging.DependencyScope dependencyScopeRuntime :: Typed.TypedTerm Packaging.DependencyScope dependencyScopeRuntime = @@ -140,6 +154,10 @@ Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.EntityMetadata +entityMetadataEntityMetadata :: Typed.TypedName Packaging.EntityMetadata +entityMetadataEntityMetadata = Typed.TypedName (Core.Name "hydra.packaging.EntityMetadata") + -- | DSL accessor for the lifecycle field of hydra.packaging.EntityMetadata entityMetadataLifecycle :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm (Maybe Packaging.LifecycleInfo) entityMetadataLifecycle x = @@ -291,6 +309,10 @@ Core.fieldName = (Core.Name "definition"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.packaging.EntityReference +entityReferenceEntityReference :: Typed.TypedName Packaging.EntityReference +entityReferenceEntityReference = Typed.TypedName (Core.Name "hydra.packaging.EntityReference") + -- | DSL injection for the module variant of hydra.packaging.EntityReference entityReferenceModule :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.EntityReference entityReferenceModule x = @@ -358,6 +380,10 @@ Core.projectionFieldName = (Core.Name "deprecatedSince")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.LifecycleInfo +lifecycleInfoLifecycleInfo :: Typed.TypedName Packaging.LifecycleInfo +lifecycleInfoLifecycleInfo = Typed.TypedName (Core.Name "hydra.packaging.LifecycleInfo") + -- | DSL updater for the availableSince field of hydra.packaging.LifecycleInfo lifecycleInfoWithAvailableSince :: Typed.TypedTerm Packaging.LifecycleInfo -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.LifecycleInfo lifecycleInfoWithAvailableSince original newVal = @@ -451,6 +477,10 @@ Core.projectionFieldName = (Core.Name "module")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.ModuleDependency +moduleDependencyModuleDependency :: Typed.TypedName Packaging.ModuleDependency +moduleDependencyModuleDependency = Typed.TypedName (Core.Name "hydra.packaging.ModuleDependency") + -- | DSL accessor for the package field of hydra.packaging.ModuleDependency moduleDependencyPackage :: Typed.TypedTerm Packaging.ModuleDependency -> Typed.TypedTerm (Maybe Packaging.PackageName) moduleDependencyPackage x = @@ -503,6 +533,10 @@ Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.Module +moduleModule :: Typed.TypedName Packaging.Module +moduleModule = Typed.TypedName (Core.Name "hydra.packaging.Module") + -- | DSL accessor for the name field of hydra.packaging.Module moduleName :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Packaging.ModuleName moduleName x = @@ -519,6 +553,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.packaging.ModuleName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.ModuleName +moduleNameModuleName :: Typed.TypedName Packaging.ModuleName +moduleNameModuleName = Typed.TypedName (Core.Name "hydra.packaging.ModuleName") + -- | DSL updater for the definitions field of hydra.packaging.Module moduleWithDefinitions :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm Packaging.Module moduleWithDefinitions original newVal = @@ -696,6 +734,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.PackageDependency +packageDependencyPackageDependency :: Typed.TypedName Packaging.PackageDependency +packageDependencyPackageDependency = Typed.TypedName (Core.Name "hydra.packaging.PackageDependency") + -- | DSL accessor for the scope field of hydra.packaging.PackageDependency packageDependencyScope :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm (Maybe Packaging.DependencyScope) packageDependencyScope x = @@ -820,6 +862,14 @@ Core.wrappedTermTypeName = (Core.Name "hydra.packaging.PackageName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.PackageName +packageNamePackageName :: Typed.TypedName Packaging.PackageName +packageNamePackageName = Typed.TypedName (Core.Name "hydra.packaging.PackageName") + +-- | DSL name token for hydra.packaging.Package +packagePackage :: Typed.TypedName Packaging.Package +packagePackage = Typed.TypedName (Core.Name "hydra.packaging.Package") + -- | DSL updater for the dependencies field of hydra.packaging.Package packageWithDependencies :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm [Packaging.PackageDependency] -> Typed.TypedTerm Packaging.Package packageWithDependencies original newVal = @@ -1014,6 +1064,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.PrimitiveDefinition +primitiveDefinitionPrimitiveDefinition :: Typed.TypedName Packaging.PrimitiveDefinition +primitiveDefinitionPrimitiveDefinition = Typed.TypedName (Core.Name "hydra.packaging.PrimitiveDefinition") + -- | DSL accessor for the signature field of hydra.packaging.PrimitiveDefinition primitiveDefinitionSignature :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Typing.TermSignature primitiveDefinitionSignature x = @@ -1348,6 +1402,10 @@ Core.projectionFieldName = (Core.Name "signature")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.TermDefinition +termDefinitionTermDefinition :: Typed.TypedName Packaging.TermDefinition +termDefinitionTermDefinition = Typed.TypedName (Core.Name "hydra.packaging.TermDefinition") + -- | DSL updater for the body field of hydra.packaging.TermDefinition termDefinitionWithBody :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Packaging.TermDefinition termDefinitionWithBody original newVal = @@ -1515,6 +1573,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.TypeDefinition +typeDefinitionTypeDefinition :: Typed.TypedName Packaging.TypeDefinition +typeDefinitionTypeDefinition = Typed.TypedName (Core.Name "hydra.packaging.TypeDefinition") + -- | DSL updater for the body field of hydra.packaging.TypeDefinition typeDefinitionWithBody :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Packaging.TypeDefinition typeDefinitionWithBody original newVal = @@ -1646,6 +1708,10 @@ Core.projectionFieldName = (Core.Name "upperExclusive")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.packaging.VersionRange +versionRangeVersionRange :: Typed.TypedName Packaging.VersionRange +versionRangeVersionRange = Typed.TypedName (Core.Name "hydra.packaging.VersionRange") + -- | DSL updater for the lowerInclusive field of hydra.packaging.VersionRange versionRangeWithLowerInclusive :: Typed.TypedTerm Packaging.VersionRange -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.VersionRange versionRangeWithLowerInclusive original newVal = @@ -1715,3 +1781,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "range"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL name token for hydra.packaging.VersionSpecifier +versionSpecifierVersionSpecifier :: Typed.TypedName Packaging.VersionSpecifier +versionSpecifierVersionSpecifier = Typed.TypedName (Core.Name "hydra.packaging.VersionSpecifier") + +-- | DSL name token for hydra.packaging.Version +versionVersion :: Typed.TypedName Packaging.Version +versionVersion = Typed.TypedName (Core.Name "hydra.packaging.Version") diff --git a/src/main/haskell/Hydra/Dsl/Parsing.hs b/src/main/haskell/Hydra/Dsl/Parsing.hs --- a/src/main/haskell/Hydra/Dsl/Parsing.hs +++ b/src/main/haskell/Hydra/Dsl/Parsing.hs @@ -5,12 +5,58 @@ module Hydra.Dsl.Parsing where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Parsing as DecodeParsing import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Parsing as EncodeParsing +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Parsing as Parsing import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +-- | DSL composition builder for the decoder of hydra.parsing.ParseResult +decodeParseResult :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Parsing.ParseResult a)) +decodeParseResult a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.parsing.parseResult")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the decoder of hydra.parsing.ParseSuccess +decodeParseSuccess :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Parsing.ParseSuccess a)) +decodeParseSuccess a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.parsing.parseSuccess")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the decoder of hydra.parsing.Parser +decodeParser :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Parsing.Parser a)) +decodeParser a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.parsing.parser")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the encoder of hydra.parsing.ParseResult +encodeParseResult :: Typed.TypedTerm (a -> Core.Term) -> Typed.TypedTerm (Parsing.ParseResult a -> Core.Term) +encodeParseResult a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.parsing.parseResult")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the encoder of hydra.parsing.ParseSuccess +encodeParseSuccess :: Typed.TypedTerm (a -> Core.Term) -> Typed.TypedTerm (Parsing.ParseSuccess a -> Core.Term) +encodeParseSuccess a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.parsing.parseSuccess")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the encoder of hydra.parsing.Parser +encodeParser :: Typed.TypedTerm (a -> Core.Term) -> Typed.TypedTerm (Parsing.Parser a -> Core.Term) +encodeParser a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.parsing.parser")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + -- | DSL constructor for hydra.parsing.ParseError parseError :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Parsing.ParseError parseError message remainder = @@ -33,6 +79,10 @@ Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.parsing.ParseError +parseErrorParseError :: Typed.TypedName Parsing.ParseError +parseErrorParseError = Typed.TypedName (Core.Name "hydra.parsing.ParseError") + -- | DSL accessor for the remainder field of hydra.parsing.ParseError parseErrorRemainder :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm String parseErrorRemainder x = @@ -85,6 +135,10 @@ Core.fieldName = (Core.Name "failure"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.parsing.ParseResult +parseResultParseResult :: Typed.TypedName (Parsing.ParseResult a) +parseResultParseResult = Typed.TypedName (Core.Name "hydra.parsing.ParseResult") + -- | DSL injection for the success variant of hydra.parsing.ParseResult parseResultSuccess :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm (Parsing.ParseResult a) parseResultSuccess x = @@ -107,6 +161,10 @@ Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = (Typed.unTypedTerm remainder)}]})) +-- | DSL name token for hydra.parsing.ParseSuccess +parseSuccessParseSuccess :: Typed.TypedName (Parsing.ParseSuccess a) +parseSuccessParseSuccess = Typed.TypedName (Core.Name "hydra.parsing.ParseSuccess") + -- | DSL accessor for the remainder field of hydra.parsing.ParseSuccess parseSuccessRemainder :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm String parseSuccessRemainder x = @@ -165,6 +223,10 @@ Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.parsing.Parser"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.parsing.Parser +parserParser :: Typed.TypedName (Parsing.Parser a) +parserParser = Typed.TypedName (Core.Name "hydra.parsing.Parser") -- | DSL accessor for the body of hydra.parsing.Parser unParser :: Typed.TypedTerm (Parsing.Parser a) -> Typed.TypedTerm (String -> Parsing.ParseResult a) diff --git a/src/main/haskell/Hydra/Dsl/Paths.hs b/src/main/haskell/Hydra/Dsl/Paths.hs --- a/src/main/haskell/Hydra/Dsl/Paths.hs +++ b/src/main/haskell/Hydra/Dsl/Paths.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Paths where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Paths as DecodePaths import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Paths as EncodePaths import qualified Hydra.Paths as Paths import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -45,6 +47,10 @@ Core.projectionFieldName = (Core.Name "source")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtermEdge +subtermEdgeSubtermEdge :: Typed.TypedName Paths.SubtermEdge +subtermEdgeSubtermEdge = Typed.TypedName (Core.Name "hydra.paths.SubtermEdge") + -- | DSL accessor for the target field of hydra.paths.SubtermEdge subtermEdgeTarget :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermNode subtermEdgeTarget x = @@ -157,6 +163,10 @@ Core.projectionFieldName = (Core.Name "nodes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtermGraph +subtermGraphSubtermGraph :: Typed.TypedName Paths.SubtermGraph +subtermGraphSubtermGraph = Typed.TypedName (Core.Name "hydra.paths.SubtermGraph") + -- | DSL updater for the edges field of hydra.paths.SubtermGraph subtermGraphWithEdges :: Typed.TypedTerm Paths.SubtermGraph -> Typed.TypedTerm [Paths.SubtermEdge] -> Typed.TypedTerm Paths.SubtermGraph subtermGraphWithEdges original newVal = @@ -234,6 +244,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtermNode +subtermNodeSubtermNode :: Typed.TypedName Paths.SubtermNode +subtermNodeSubtermNode = Typed.TypedName (Core.Name "hydra.paths.SubtermNode") + -- | DSL updater for the id field of hydra.paths.SubtermNode subtermNodeWithId :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtermNode subtermNodeWithId original newVal = @@ -313,6 +327,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtermPath"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtermPath +subtermPathSubtermPath :: Typed.TypedName Paths.SubtermPath +subtermPathSubtermPath = Typed.TypedName (Core.Name "hydra.paths.SubtermPath") + -- | DSL injection for the annotatedBody variant of hydra.paths.SubtermStep subtermStepAnnotatedBody :: Typed.TypedTerm Paths.SubtermStep subtermStepAnnotatedBody = @@ -439,6 +457,10 @@ Core.fieldName = (Core.Name "setElement"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.paths.SubtermStep +subtermStepSubtermStep :: Typed.TypedName Paths.SubtermStep +subtermStepSubtermStep = Typed.TypedName (Core.Name "hydra.paths.SubtermStep") + -- | DSL injection for the sumTerm variant of hydra.paths.SubtermStep subtermStepSumTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepSumTerm = @@ -527,6 +549,10 @@ Core.projectionFieldName = (Core.Name "source")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtypeEdge +subtypeEdgeSubtypeEdge :: Typed.TypedName Paths.SubtypeEdge +subtypeEdgeSubtypeEdge = Typed.TypedName (Core.Name "hydra.paths.SubtypeEdge") + -- | DSL accessor for the target field of hydra.paths.SubtypeEdge subtypeEdgeTarget :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypeNode subtypeEdgeTarget x = @@ -639,6 +665,10 @@ Core.projectionFieldName = (Core.Name "nodes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtypeGraph +subtypeGraphSubtypeGraph :: Typed.TypedName Paths.SubtypeGraph +subtypeGraphSubtypeGraph = Typed.TypedName (Core.Name "hydra.paths.SubtypeGraph") + -- | DSL updater for the edges field of hydra.paths.SubtypeGraph subtypeGraphWithEdges :: Typed.TypedTerm Paths.SubtypeGraph -> Typed.TypedTerm [Paths.SubtypeEdge] -> Typed.TypedTerm Paths.SubtypeGraph subtypeGraphWithEdges original newVal = @@ -716,6 +746,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtypeNode +subtypeNodeSubtypeNode :: Typed.TypedName Paths.SubtypeNode +subtypeNodeSubtypeNode = Typed.TypedName (Core.Name "hydra.paths.SubtypeNode") + -- | DSL updater for the id field of hydra.paths.SubtypeNode subtypeNodeWithId :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtypeNode subtypeNodeWithId original newVal = @@ -795,6 +829,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtypePath"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.paths.SubtypePath +subtypePathSubtypePath :: Typed.TypedName Paths.SubtypePath +subtypePathSubtypePath = Typed.TypedName (Core.Name "hydra.paths.SubtypePath") + -- | DSL injection for the annotatedBody variant of hydra.paths.SubtypeStep subtypeStepAnnotatedBody :: Typed.TypedTerm Paths.SubtypeStep subtypeStepAnnotatedBody = @@ -938,6 +976,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "setElement"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.paths.SubtypeStep +subtypeStepSubtypeStep :: Typed.TypedName Paths.SubtypeStep +subtypeStepSubtypeStep = Typed.TypedName (Core.Name "hydra.paths.SubtypeStep") -- | DSL injection for the unionField variant of hydra.paths.SubtypeStep subtypeStepUnionField :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtypeStep diff --git a/src/main/haskell/Hydra/Dsl/Predicates.hs b/src/main/haskell/Hydra/Dsl/Predicates.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Predicates.hs @@ -0,0 +1,215 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.predicates + +module Hydra.Dsl.Predicates where + +import qualified Hydra.Arity as Arity +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Dependencies as Dependencies +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Arity as DslArity +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Dependencies as DslDependencies +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Predicates as Predicates +import qualified Hydra.Query as Query +import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Rewriting as Rewriting +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.predicates.isComplexBinding +isComplexBinding :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Binding -> Typed.TypedTerm Bool +isComplexBinding arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isComplexBinding")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.predicates.isComplexTerm +isComplexTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isComplexTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isComplexTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.predicates.isComplexVariable +isComplexVariable :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Bool +isComplexVariable arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isComplexVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.predicates.isEncodedTerm +isEncodedTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isEncodedTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isEncodedTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isEncodedType +isEncodedType :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isEncodedType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isEncodedType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isEnumRowType +isEnumRowType :: Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm Bool +isEnumRowType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isEnumRowType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isEnumType +isEnumType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +isEnumType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isEnumType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isNominalType +isNominalType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +isNominalType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isNominalType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isSerializable +isSerializable :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Binding -> Typed.TypedTerm (Either Errors.Error Bool) +isSerializable arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isSerializable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.predicates.isSerializableByName +isSerializableByName :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Bool) +isSerializableByName arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isSerializableByName")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.predicates.isSerializableType +isSerializableType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +isSerializableType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isSerializableType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isTrivialTerm +isTrivialTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isTrivialTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isTrivialTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isType +isType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +isType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isUnitTerm +isUnitTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isUnitTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isUnitTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.isUnitType +isUnitType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +isUnitType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.isUnitType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.predicates.typeDependencies +typeDependencies :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Bool -> Typed.TypedTerm (Core.Type -> Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (M.Map Core.Name Core.Type)) +typeDependencies arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.predicates.typeDependencies")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) diff --git a/src/main/haskell/Hydra/Dsl/Print/Docs.hs b/src/main/haskell/Hydra/Dsl/Print/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Print/Docs.hs @@ -0,0 +1,129 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.print.docs + +module Hydra.Dsl.Print.Docs where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parse.Docs as ParseDocs +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Docs as PrintDocs +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.print.docs.definitionReference +definitionReference :: Typed.TypedTerm Packaging.DefinitionReference -> Typed.TypedTerm String +definitionReference arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.definitionReference")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.print.docs.docSegment +docSegment :: Typed.TypedTerm Docs.DocSegment -> Typed.TypedTerm String +docSegment arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.docSegment")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.print.docs.docSegmentWith +docSegmentWith :: Typed.TypedTerm (Packaging.EntityReference -> String) -> Typed.TypedTerm Docs.DocSegment -> Typed.TypedTerm String +docSegmentWith arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.docSegmentWith")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.print.docs.docSegments +docSegments :: Typed.TypedTerm [Docs.DocSegment] -> Typed.TypedTerm String +docSegments arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.docSegments")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.print.docs.docSegmentsWith +docSegmentsWith :: Typed.TypedTerm (Packaging.EntityReference -> String) -> Typed.TypedTerm [Docs.DocSegment] -> Typed.TypedTerm String +docSegmentsWith arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.docSegmentsWith")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.print.docs.entityReference +entityReference :: Typed.TypedTerm Packaging.EntityReference -> Typed.TypedTerm String +entityReference arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.entityReference")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.print.docs.renderDocString +renderDocString :: Typed.TypedTerm String -> Typed.TypedTerm String +renderDocString arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.renderDocString")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.print.docs.renderDocStringWith +renderDocStringWith :: Typed.TypedTerm (Packaging.EntityReference -> String) -> Typed.TypedTerm String -> Typed.TypedTerm String +renderDocStringWith arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.print.docs.renderDocStringWith")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) diff --git a/src/main/haskell/Hydra/Dsl/Query.hs b/src/main/haskell/Hydra/Dsl/Query.hs --- a/src/main/haskell/Hydra/Dsl/Query.hs +++ b/src/main/haskell/Hydra/Dsl/Query.hs @@ -5,12 +5,18 @@ module Hydra.Dsl.Query where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Query as DecodeQuery import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Query as EncodeQuery import qualified Hydra.Query as Query import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +-- | DSL name token for hydra.query.ComparisonConstraint +comparisonConstraintComparisonConstraint :: Typed.TypedName Query.ComparisonConstraint +comparisonConstraintComparisonConstraint = Typed.TypedName (Core.Name "hydra.query.ComparisonConstraint") + -- | DSL injection for the equal variant of hydra.query.ComparisonConstraint comparisonConstraintEqual :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintEqual = @@ -81,6 +87,10 @@ Core.fieldName = (Core.Name "in"), Core.fieldTerm = (Typed.unTypedTerm in_)}]})) +-- | DSL name token for hydra.query.Edge +edgeEdge :: Typed.TypedName Query.Edge +edgeEdge = Typed.TypedName (Core.Name "hydra.query.Edge") + -- | DSL accessor for the in field of hydra.query.Edge edgeIn :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm (Maybe Core.Name) edgeIn x = @@ -202,6 +212,10 @@ Core.projectionFieldName = (Core.Name "graph")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.GraphPattern +graphPatternGraphPattern :: Typed.TypedName Query.GraphPattern +graphPatternGraphPattern = Typed.TypedName (Core.Name "hydra.query.GraphPattern") + -- | DSL accessor for the patterns field of hydra.query.GraphPattern graphPatternPatterns :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm [Query.Pattern] graphPatternPatterns x = @@ -245,6 +259,10 @@ Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL name token for hydra.query.Node +nodeNode :: Typed.TypedName Query.Node +nodeNode = Typed.TypedName (Core.Name "hydra.query.Node") + -- | DSL injection for the term variant of hydra.query.Node nodeTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Query.Node nodeTerm x = @@ -294,6 +312,10 @@ Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.PathEquation +pathEquationPathEquation :: Typed.TypedName Query.PathEquation +pathEquationPathEquation = Typed.TypedName (Core.Name "hydra.query.PathEquation") + -- | DSL accessor for the right field of hydra.query.PathEquation pathEquationRight :: Typed.TypedTerm Query.PathEquation -> Typed.TypedTerm Query.Path pathEquationRight x = @@ -346,6 +368,10 @@ Core.fieldName = (Core.Name "inverse"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.query.Path +pathPath :: Typed.TypedName Query.Path +pathPath = Typed.TypedName (Core.Name "hydra.query.Path") + -- | DSL injection for the regex variant of hydra.query.Path pathRegex :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.Path pathRegex x = @@ -422,6 +448,10 @@ Core.projectionFieldName = (Core.Name "consequent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.PatternImplication +patternImplicationPatternImplication :: Typed.TypedName Query.PatternImplication +patternImplicationPatternImplication = Typed.TypedName (Core.Name "hydra.query.PatternImplication") + -- | DSL updater for the antecedent field of hydra.query.PatternImplication patternImplicationWithAntecedent :: Typed.TypedTerm Query.PatternImplication -> Typed.TypedTerm Query.Pattern -> Typed.TypedTerm Query.PatternImplication patternImplicationWithAntecedent original newVal = @@ -465,6 +495,10 @@ Core.fieldName = (Core.Name "negation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.query.Pattern +patternPattern :: Typed.TypedName Query.Pattern +patternPattern = Typed.TypedName (Core.Name "hydra.query.Pattern") + -- | DSL injection for the triple variant of hydra.query.Pattern patternTriple :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Pattern patternTriple x = @@ -496,6 +530,10 @@ Core.projectionFieldName = (Core.Name "patterns")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.Query +queryQuery :: Typed.TypedName Query.Query +queryQuery = Typed.TypedName (Core.Name "hydra.query.Query") + -- | DSL accessor for the variables field of hydra.query.Query queryVariables :: Typed.TypedTerm Query.Query -> Typed.TypedTerm [Query.Variable] queryVariables x = @@ -570,6 +608,10 @@ Core.projectionFieldName = (Core.Name "min")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.Range +rangeRange :: Typed.TypedName Query.Range +rangeRange = Typed.TypedName (Core.Name "hydra.query.Range") + -- | DSL updater for the max field of hydra.query.Range rangeWithMax :: Typed.TypedTerm Query.Range -> Typed.TypedTerm Int -> Typed.TypedTerm Query.Range rangeWithMax original newVal = @@ -649,6 +691,10 @@ Core.fieldName = (Core.Name "range"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.query.RegexQuantifier +regexQuantifierRegexQuantifier :: Typed.TypedName Query.RegexQuantifier +regexQuantifierRegexQuantifier = Typed.TypedName (Core.Name "hydra.query.RegexQuantifier") + -- | DSL injection for the zeroOrMore variant of hydra.query.RegexQuantifier regexQuantifierZeroOrMore :: Typed.TypedTerm Query.RegexQuantifier regexQuantifierZeroOrMore = @@ -698,6 +744,10 @@ Core.projectionFieldName = (Core.Name "quantifier")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.RegexSequence +regexSequenceRegexSequence :: Typed.TypedName Query.RegexSequence +regexSequenceRegexSequence = Typed.TypedName (Core.Name "hydra.query.RegexSequence") + -- | DSL updater for the path field of hydra.query.RegexSequence regexSequenceWithPath :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.RegexSequence regexSequenceWithPath original newVal = @@ -759,6 +809,10 @@ Core.fieldName = (Core.Name "project"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.query.Step +stepStep :: Typed.TypedName Query.Step +stepStep = Typed.TypedName (Core.Name "hydra.query.Step") + -- | DSL constructor for hydra.query.TriplePattern triplePattern :: Typed.TypedTerm Query.Node -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.Node -> Typed.TypedTerm Query.TriplePattern triplePattern subject predicate object = @@ -802,6 +856,10 @@ Core.projectionFieldName = (Core.Name "subject")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.query.TriplePattern +triplePatternTriplePattern :: Typed.TypedName Query.TriplePattern +triplePatternTriplePattern = Typed.TypedName (Core.Name "hydra.query.TriplePattern") + -- | DSL updater for the object field of hydra.query.TriplePattern triplePatternWithObject :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Node -> Typed.TypedTerm Query.TriplePattern triplePatternWithObject original newVal = @@ -887,3 +945,7 @@ Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.query.Variable"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.query.Variable +variableVariable :: Typed.TypedName Query.Variable +variableVariable = Typed.TypedName (Core.Name "hydra.query.Variable") diff --git a/src/main/haskell/Hydra/Dsl/Reduction.hs b/src/main/haskell/Hydra/Dsl/Reduction.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Reduction.hs @@ -0,0 +1,185 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.reduction + +module Hydra.Dsl.Reduction where + +import qualified Hydra.Annotations as Annotations +import qualified Hydra.Arity as Arity +import qualified Hydra.Ast as Ast +import qualified Hydra.Checking as Checking +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Annotations as DslAnnotations +import qualified Hydra.Dsl.Arity as DslArity +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Checking as DslChecking +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as DslErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Resolution as DslResolution +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as ErrorChecking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Hoisting as Hoisting +import qualified Hydra.Inference as Inference +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Query as Query +import qualified Hydra.Reduction as Reduction +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Resolution as Resolution +import qualified Hydra.Rewriting as Rewriting +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.reduction.alphaConvert +alphaConvert :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +alphaConvert arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.alphaConvert")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.reduction.betaReduceType +betaReduceType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either Errors.Error Core.Type) +betaReduceType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.betaReduceType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.reduction.contractTerm +contractTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +contractTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.contractTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.reduction.countPrimitiveInvocations +countPrimitiveInvocations :: Typed.TypedTerm Bool +countPrimitiveInvocations = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.reduction.countPrimitiveInvocations")) + +-- | DSL reference to hydra.reduction.etaExpandTerm +etaExpandTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +etaExpandTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.etaExpandTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.reduction.etaExpandTypedTerm +etaExpandTypedTerm :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error Core.Term) +etaExpandTypedTerm arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.etaExpandTypedTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.reduction.etaExpansionArity +etaExpansionArity :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Int +etaExpansionArity arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.etaExpansionArity")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.reduction.etaReduceTerm +etaReduceTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +etaReduceTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.etaReduceTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.reduction.reduceTerm +reduceTerm :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either Errors.Error Core.Term) +reduceTerm arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.reduceTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.reduction.termIsClosed +termIsClosed :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +termIsClosed arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.termIsClosed")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.reduction.termIsValue +termIsValue :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +termIsValue arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.reduction.termIsValue")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Refs.hs b/src/main/haskell/Hydra/Dsl/Refs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Refs.hs @@ -0,0 +1,140 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.refs + +module Hydra.Dsl.Refs where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Refs as Refs +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.refs.decodeRef +decodeRef :: Typed.TypedTerm (Typed.TypedName t0) -> Typed.TypedTerm Core.Term +decodeRef arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.decodeRef")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.refs.encodeList +encodeList :: Typed.TypedTerm (t0 -> Core.Term) -> Typed.TypedTerm [t0] -> Typed.TypedTerm Core.Term +encodeList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodeList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.refs.encodeMap +encodeMap :: Ord t0 => (Typed.TypedTerm (t0 -> Core.Term) -> Typed.TypedTerm (t1 -> Core.Term) -> Typed.TypedTerm (M.Map t0 t1) -> Typed.TypedTerm Core.Term) +encodeMap arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodeMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.refs.encodeOptional +encodeOptional :: Typed.TypedTerm (t0 -> Core.Term) -> Typed.TypedTerm (Maybe t0) -> Typed.TypedTerm Core.Term +encodeOptional arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodeOptional")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.refs.encodePair +encodePair :: Typed.TypedTerm (t0 -> Core.Term) -> Typed.TypedTerm (t1 -> Core.Term) -> Typed.TypedTerm (t0, t1) -> Typed.TypedTerm Core.Term +encodePair arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodePair")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.refs.encodeRef +encodeRef :: Typed.TypedTerm (Typed.TypedName t0) -> Typed.TypedTerm Core.Term +encodeRef arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodeRef")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.refs.encodeSet +encodeSet :: Ord t0 => (Typed.TypedTerm (t0 -> Core.Term) -> Typed.TypedTerm (S.Set t0) -> Typed.TypedTerm Core.Term) +encodeSet arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.encodeSet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.refs.showRef +showRef :: Typed.TypedTerm (Typed.TypedName t0) -> Typed.TypedTerm Core.Term +showRef arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.refs.showRef")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Regex.hs b/src/main/haskell/Hydra/Dsl/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Regex.hs @@ -0,0 +1,436 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.regex + +module Hydra.Dsl.Regex where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Regex as DecodeRegex +import qualified Hydra.Encode.Regex as EncodeRegex +import qualified Hydra.Regex as Regex +import qualified Hydra.Typed as Typed +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL injection for the anchorEnd variant of hydra.regex.Atom +atomAnchorEnd :: Typed.TypedTerm Regex.Atom +atomAnchorEnd = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "anchorEnd"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the anchorStart variant of hydra.regex.Atom +atomAnchorStart :: Typed.TypedTerm Regex.Atom +atomAnchorStart = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "anchorStart"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the any variant of hydra.regex.Atom +atomAny :: Typed.TypedTerm Regex.Atom +atomAny = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "any"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.regex.Atom +atomAtom :: Typed.TypedName Regex.Atom +atomAtom = Typed.TypedName (Core.Name "hydra.regex.Atom") + +-- | DSL injection for the class variant of hydra.regex.Atom +atomClass :: Typed.TypedTerm Regex.CharacterClass -> Typed.TypedTerm Regex.Atom +atomClass x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "class"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the group variant of hydra.regex.Atom +atomGroup :: Typed.TypedTerm Regex.Alternation -> Typed.TypedTerm Regex.Atom +atomGroup x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "group"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the literal variant of hydra.regex.Atom +atomLiteral :: Typed.TypedTerm Int -> Typed.TypedTerm Regex.Atom +atomLiteral x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "literal"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL constructor for hydra.regex.CharacterClass +characterClass :: Typed.TypedTerm Bool -> Typed.TypedTerm [Regex.ClassItem] -> Typed.TypedTerm Regex.CharacterClass +characterClass negated items = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "negated"), + Core.fieldTerm = (Typed.unTypedTerm negated)}, + Core.Field { + Core.fieldName = (Core.Name "items"), + Core.fieldTerm = (Typed.unTypedTerm items)}]})) + +-- | DSL name token for hydra.regex.CharacterClass +characterClassCharacterClass :: Typed.TypedName Regex.CharacterClass +characterClassCharacterClass = Typed.TypedName (Core.Name "hydra.regex.CharacterClass") + +-- | DSL accessor for the items field of hydra.regex.CharacterClass +characterClassItems :: Typed.TypedTerm Regex.CharacterClass -> Typed.TypedTerm [Regex.ClassItem] +characterClassItems x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.projectionFieldName = (Core.Name "items")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the negated field of hydra.regex.CharacterClass +characterClassNegated :: Typed.TypedTerm Regex.CharacterClass -> Typed.TypedTerm Bool +characterClassNegated x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.projectionFieldName = (Core.Name "negated")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the items field of hydra.regex.CharacterClass +characterClassWithItems :: Typed.TypedTerm Regex.CharacterClass -> Typed.TypedTerm [Regex.ClassItem] -> Typed.TypedTerm Regex.CharacterClass +characterClassWithItems original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "negated"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.projectionFieldName = (Core.Name "negated")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "items"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the negated field of hydra.regex.CharacterClass +characterClassWithNegated :: Typed.TypedTerm Regex.CharacterClass -> Typed.TypedTerm Bool -> Typed.TypedTerm Regex.CharacterClass +characterClassWithNegated original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "negated"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "items"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.projectionFieldName = (Core.Name "items")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL constructor for hydra.regex.CharacterRange +characterRange :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.CharacterRange +characterRange from to = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "from"), + Core.fieldTerm = (Typed.unTypedTerm from)}, + Core.Field { + Core.fieldName = (Core.Name "to"), + Core.fieldTerm = (Typed.unTypedTerm to)}]})) + +-- | DSL name token for hydra.regex.CharacterRange +characterRangeCharacterRange :: Typed.TypedName Regex.CharacterRange +characterRangeCharacterRange = Typed.TypedName (Core.Name "hydra.regex.CharacterRange") + +-- | DSL accessor for the from field of hydra.regex.CharacterRange +characterRangeFrom :: Typed.TypedTerm Regex.CharacterRange -> Typed.TypedTerm Int +characterRangeFrom x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.projectionFieldName = (Core.Name "from")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the to field of hydra.regex.CharacterRange +characterRangeTo :: Typed.TypedTerm Regex.CharacterRange -> Typed.TypedTerm Int +characterRangeTo x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.projectionFieldName = (Core.Name "to")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the from field of hydra.regex.CharacterRange +characterRangeWithFrom :: Typed.TypedTerm Regex.CharacterRange -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.CharacterRange +characterRangeWithFrom original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "from"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "to"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.projectionFieldName = (Core.Name "to")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the to field of hydra.regex.CharacterRange +characterRangeWithTo :: Typed.TypedTerm Regex.CharacterRange -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.CharacterRange +characterRangeWithTo original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "from"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.projectionFieldName = (Core.Name "from")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "to"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL injection for the character variant of hydra.regex.ClassItem +classItemCharacter :: Typed.TypedTerm Int -> Typed.TypedTerm Regex.ClassItem +classItemCharacter x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.ClassItem"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "character"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL name token for hydra.regex.ClassItem +classItemClassItem :: Typed.TypedName Regex.ClassItem +classItemClassItem = Typed.TypedName (Core.Name "hydra.regex.ClassItem") + +-- | DSL injection for the range variant of hydra.regex.ClassItem +classItemRange :: Typed.TypedTerm Regex.CharacterRange -> Typed.TypedTerm Regex.ClassItem +classItemRange x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.ClassItem"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL constructor for hydra.regex.Quantified +quantified :: Typed.TypedTerm Regex.Atom -> Typed.TypedTerm Regex.Quantifier -> Typed.TypedTerm Regex.Quantified +quantified atom quantifier = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.Quantified"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "atom"), + Core.fieldTerm = (Typed.unTypedTerm atom)}, + Core.Field { + Core.fieldName = (Core.Name "quantifier"), + Core.fieldTerm = (Typed.unTypedTerm quantifier)}]})) + +-- | DSL accessor for the atom field of hydra.regex.Quantified +quantifiedAtom :: Typed.TypedTerm Regex.Quantified -> Typed.TypedTerm Regex.Atom +quantifiedAtom x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.Quantified"), + Core.projectionFieldName = (Core.Name "atom")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.regex.Quantified +quantifiedQuantified :: Typed.TypedName Regex.Quantified +quantifiedQuantified = Typed.TypedName (Core.Name "hydra.regex.Quantified") + +-- | DSL accessor for the quantifier field of hydra.regex.Quantified +quantifiedQuantifier :: Typed.TypedTerm Regex.Quantified -> Typed.TypedTerm Regex.Quantifier +quantifiedQuantifier x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.Quantified"), + Core.projectionFieldName = (Core.Name "quantifier")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the atom field of hydra.regex.Quantified +quantifiedWithAtom :: Typed.TypedTerm Regex.Quantified -> Typed.TypedTerm Regex.Atom -> Typed.TypedTerm Regex.Quantified +quantifiedWithAtom original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.Quantified"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "atom"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "quantifier"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.Quantified"), + Core.projectionFieldName = (Core.Name "quantifier")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the quantifier field of hydra.regex.Quantified +quantifiedWithQuantifier :: Typed.TypedTerm Regex.Quantified -> Typed.TypedTerm Regex.Quantifier -> Typed.TypedTerm Regex.Quantified +quantifiedWithQuantifier original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.Quantified"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "atom"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.Quantified"), + Core.projectionFieldName = (Core.Name "atom")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "quantifier"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL injection for the atLeast variant of hydra.regex.Quantifier +quantifierAtLeast :: Typed.TypedTerm Int -> Typed.TypedTerm Regex.Quantifier +quantifierAtLeast x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "atLeast"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the exactly variant of hydra.regex.Quantifier +quantifierExactly :: Typed.TypedTerm Int -> Typed.TypedTerm Regex.Quantifier +quantifierExactly x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "exactly"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the one variant of hydra.regex.Quantifier +quantifierOne :: Typed.TypedTerm Regex.Quantifier +quantifierOne = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "one"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the oneOrMore variant of hydra.regex.Quantifier +quantifierOneOrMore :: Typed.TypedTerm Regex.Quantifier +quantifierOneOrMore = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "oneOrMore"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.regex.Quantifier +quantifierQuantifier :: Typed.TypedName Regex.Quantifier +quantifierQuantifier = Typed.TypedName (Core.Name "hydra.regex.Quantifier") + +-- | DSL injection for the range variant of hydra.regex.Quantifier +quantifierRange :: Typed.TypedTerm Regex.QuantifierRange -> Typed.TypedTerm Regex.Quantifier +quantifierRange x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL constructor for hydra.regex.QuantifierRange +quantifierRange2 :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.QuantifierRange +quantifierRange2 min max = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "min"), + Core.fieldTerm = (Typed.unTypedTerm min)}, + Core.Field { + Core.fieldName = (Core.Name "max"), + Core.fieldTerm = (Typed.unTypedTerm max)}]})) + +-- | DSL accessor for the max field of hydra.regex.QuantifierRange +quantifierRangeMax :: Typed.TypedTerm Regex.QuantifierRange -> Typed.TypedTerm Int +quantifierRangeMax x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.projectionFieldName = (Core.Name "max")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the min field of hydra.regex.QuantifierRange +quantifierRangeMin :: Typed.TypedTerm Regex.QuantifierRange -> Typed.TypedTerm Int +quantifierRangeMin x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.projectionFieldName = (Core.Name "min")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.regex.QuantifierRange +quantifierRangeQuantifierRange :: Typed.TypedName Regex.QuantifierRange +quantifierRangeQuantifierRange = Typed.TypedName (Core.Name "hydra.regex.QuantifierRange") + +-- | DSL updater for the max field of hydra.regex.QuantifierRange +quantifierRangeWithMax :: Typed.TypedTerm Regex.QuantifierRange -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.QuantifierRange +quantifierRangeWithMax original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "min"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.projectionFieldName = (Core.Name "min")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "max"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the min field of hydra.regex.QuantifierRange +quantifierRangeWithMin :: Typed.TypedTerm Regex.QuantifierRange -> Typed.TypedTerm Int -> Typed.TypedTerm Regex.QuantifierRange +quantifierRangeWithMin original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "min"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "max"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.projectionFieldName = (Core.Name "max")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL injection for the zeroOrMore variant of hydra.regex.Quantifier +quantifierZeroOrMore :: Typed.TypedTerm Regex.Quantifier +quantifierZeroOrMore = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "zeroOrMore"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the zeroOrOne variant of hydra.regex.Quantifier +quantifierZeroOrOne :: Typed.TypedTerm Regex.Quantifier +quantifierZeroOrOne = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "zeroOrOne"), + Core.fieldTerm = Core.TermUnit}})) diff --git a/src/main/haskell/Hydra/Dsl/Relational.hs b/src/main/haskell/Hydra/Dsl/Relational.hs --- a/src/main/haskell/Hydra/Dsl/Relational.hs +++ b/src/main/haskell/Hydra/Dsl/Relational.hs @@ -5,7 +5,11 @@ module Hydra.Dsl.Relational where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Relational as DecodeRelational import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Relational as EncodeRelational +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Relational as Relational import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -20,6 +24,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.relational.ColumnName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.relational.ColumnName +columnNameColumnName :: Typed.TypedName Relational.ColumnName +columnNameColumnName = Typed.TypedName (Core.Name "hydra.relational.ColumnName") + -- | DSL constructor for hydra.relational.ColumnSchema columnSchema :: Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm t -> Typed.TypedTerm (Relational.ColumnSchema t) columnSchema name domain = @@ -33,6 +41,10 @@ Core.fieldName = (Core.Name "domain"), Core.fieldTerm = (Typed.unTypedTerm domain)}]})) +-- | DSL name token for hydra.relational.ColumnSchema +columnSchemaColumnSchema :: Typed.TypedName (Relational.ColumnSchema t) +columnSchemaColumnSchema = Typed.TypedName (Core.Name "hydra.relational.ColumnSchema") + -- | DSL accessor for the domain field of hydra.relational.ColumnSchema columnSchemaDomain :: Typed.TypedTerm (Relational.ColumnSchema t) -> Typed.TypedTerm t columnSchemaDomain x = @@ -85,6 +97,76 @@ Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) +-- | DSL composition builder for the decoder of hydra.relational.ColumnSchema +decodeColumnSchema :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.ColumnSchema t)) +decodeColumnSchema t = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.relational.columnSchema")), + Core.applicationArgument = (Typed.unTypedTerm t)})) + +-- | DSL composition builder for the decoder of hydra.relational.Relation +decodeRelation :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Relation v)) +decodeRelation v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.relational.relation")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the decoder of hydra.relational.RelationSchema +decodeRelationSchema :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError t) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.RelationSchema t)) +decodeRelationSchema t = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.relational.relationSchema")), + Core.applicationArgument = (Typed.unTypedTerm t)})) + +-- | DSL composition builder for the decoder of hydra.relational.Relationship +decodeRelationship :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Relationship v)) +decodeRelationship v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.relational.relationship")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the decoder of hydra.relational.Row +decodeRow :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Row v)) +decodeRow v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.relational.row")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the encoder of hydra.relational.ColumnSchema +encodeColumnSchema :: Typed.TypedTerm (t -> Core.Term) -> Typed.TypedTerm (Relational.ColumnSchema t -> Core.Term) +encodeColumnSchema t = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.relational.columnSchema")), + Core.applicationArgument = (Typed.unTypedTerm t)})) + +-- | DSL composition builder for the encoder of hydra.relational.Relation +encodeRelation :: Typed.TypedTerm (v -> Core.Term) -> Typed.TypedTerm (Relational.Relation v -> Core.Term) +encodeRelation v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.relational.relation")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the encoder of hydra.relational.RelationSchema +encodeRelationSchema :: Typed.TypedTerm (t -> Core.Term) -> Typed.TypedTerm (Relational.RelationSchema t -> Core.Term) +encodeRelationSchema t = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.relational.relationSchema")), + Core.applicationArgument = (Typed.unTypedTerm t)})) + +-- | DSL composition builder for the encoder of hydra.relational.Relationship +encodeRelationship :: Typed.TypedTerm (v -> Core.Term) -> Typed.TypedTerm (Relational.Relationship v -> Core.Term) +encodeRelationship v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.relational.relationship")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the encoder of hydra.relational.Row +encodeRow :: Typed.TypedTerm (v -> Core.Term) -> Typed.TypedTerm (Relational.Row v -> Core.Term) +encodeRow v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.relational.row")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + -- | DSL constructor for hydra.relational.ForeignKey foreignKey :: Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm (M.Map Relational.ColumnName Relational.ColumnName) -> Typed.TypedTerm Relational.ForeignKey foreignKey foreignRelation keys = @@ -98,6 +180,10 @@ Core.fieldName = (Core.Name "keys"), Core.fieldTerm = (Typed.unTypedTerm keys)}]})) +-- | DSL name token for hydra.relational.ForeignKey +foreignKeyForeignKey :: Typed.TypedName Relational.ForeignKey +foreignKeyForeignKey = Typed.TypedName (Core.Name "hydra.relational.ForeignKey") + -- | DSL accessor for the foreignRelation field of hydra.relational.ForeignKey foreignKeyForeignRelation :: Typed.TypedTerm Relational.ForeignKey -> Typed.TypedTerm Relational.RelationName foreignKeyForeignRelation x = @@ -157,6 +243,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.relational.PrimaryKey"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.relational.PrimaryKey +primaryKeyPrimaryKey :: Typed.TypedName Relational.PrimaryKey +primaryKeyPrimaryKey = Typed.TypedName (Core.Name "hydra.relational.PrimaryKey") + -- | DSL constructor for the hydra.relational.Relation wrapper relation :: Typed.TypedTerm [Relational.Row v] -> Typed.TypedTerm (Relational.Relation v) relation x = @@ -171,6 +261,14 @@ Core.wrappedTermTypeName = (Core.Name "hydra.relational.RelationName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.relational.RelationName +relationNameRelationName :: Typed.TypedName Relational.RelationName +relationNameRelationName = Typed.TypedName (Core.Name "hydra.relational.RelationName") + +-- | DSL name token for hydra.relational.Relation +relationRelation :: Typed.TypedName (Relational.Relation v) +relationRelation = Typed.TypedName (Core.Name "hydra.relational.Relation") + -- | DSL constructor for hydra.relational.RelationSchema relationSchema :: Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm [Relational.ColumnSchema t] -> Typed.TypedTerm [Relational.PrimaryKey] -> Typed.TypedTerm [Relational.ForeignKey] -> Typed.TypedTerm (Relational.RelationSchema t) relationSchema name columns primaryKeys foreignKeys = @@ -226,6 +324,10 @@ Core.projectionFieldName = (Core.Name "primaryKeys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.relational.RelationSchema +relationSchemaRelationSchema :: Typed.TypedName (Relational.RelationSchema t) +relationSchemaRelationSchema = Typed.TypedName (Core.Name "hydra.relational.RelationSchema") + -- | DSL updater for the columns field of hydra.relational.RelationSchema relationSchemaWithColumns :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.ColumnSchema t] -> Typed.TypedTerm (Relational.RelationSchema t) relationSchemaWithColumns original newVal = @@ -357,12 +459,20 @@ Core.wrappedTermTypeName = (Core.Name "hydra.relational.Relationship"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.relational.Relationship +relationshipRelationship :: Typed.TypedName (Relational.Relationship v) +relationshipRelationship = Typed.TypedName (Core.Name "hydra.relational.Relationship") + -- | DSL constructor for the hydra.relational.Row wrapper row :: Typed.TypedTerm [v] -> Typed.TypedTerm (Relational.Row v) row x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.Row"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.relational.Row +rowRow :: Typed.TypedName (Relational.Row v) +rowRow = Typed.TypedName (Core.Name "hydra.relational.Row") -- | DSL accessor for the body of hydra.relational.ColumnName unColumnName :: Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm String diff --git a/src/main/haskell/Hydra/Dsl/Resolution.hs b/src/main/haskell/Hydra/Dsl/Resolution.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Resolution.hs @@ -0,0 +1,262 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.resolution + +module Hydra.Dsl.Resolution where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.Strip as DslStrip +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variables as DslVariables +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Resolution as Resolution +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | DSL reference to hydra.resolution.dereferenceType +dereferenceType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (Maybe Core.Type)) +dereferenceType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.dereferenceType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.fTypeIsPolymorphic +fTypeIsPolymorphic :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool +fTypeIsPolymorphic arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fTypeIsPolymorphic")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.resolution.fieldMap +fieldMap :: Typed.TypedTerm [Core.Field] -> Typed.TypedTerm (M.Map Core.Name Core.Term) +fieldMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fieldMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.resolution.fieldTypeMap +fieldTypeMap :: Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm (M.Map Core.Name Core.Type) +fieldTypeMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fieldTypeMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.resolution.fieldTypes +fieldTypes :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either Errors.Error (M.Map Core.Name Core.Type)) +fieldTypes arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fieldTypes")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.findFieldType +findFieldType :: Typed.TypedTerm t0 -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm (Either Errors.Error Core.Type) +findFieldType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.findFieldType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.fullyStripAndNormalizeType +fullyStripAndNormalizeType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +fullyStripAndNormalizeType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fullyStripAndNormalizeType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.resolution.fullyStripType +fullyStripType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +fullyStripType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.fullyStripType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.resolution.instantiateType +instantiateType :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Core.Type, Typing.InferenceContext) +instantiateType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.instantiateType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.resolution.instantiateTypeScheme +instantiateTypeScheme :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm (Core.TypeScheme, Typing.InferenceContext) +instantiateTypeScheme arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.instantiateTypeScheme")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.resolution.nominalApplication +nominalApplication :: Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Type +nominalApplication arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.nominalApplication")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.resolution.requireRecordType +requireRecordType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error [Core.FieldType]) +requireRecordType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireRecordType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.requireRowType +requireRowType :: Typed.TypedTerm t0 -> Typed.TypedTerm String -> Typed.TypedTerm (Core.Type -> Maybe t1) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error t1) +requireRowType arg0 arg1 arg2 arg3 arg4 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireRowType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})), + Core.applicationArgument = (Typed.unTypedTerm arg4)})) + +-- | DSL reference to hydra.resolution.requireSchemaType +requireSchemaType :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error (Core.TypeScheme, Typing.InferenceContext)) +requireSchemaType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireSchemaType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.requireType +requireType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.Type) +requireType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.requireUnionField +requireUnionField :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error Core.Type) +requireUnionField arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireUnionField")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.resolution.requireUnionType +requireUnionType :: Typed.TypedTerm t0 -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Name -> Typed.TypedTerm (Either Errors.Error [Core.FieldType]) +requireUnionType arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.requireUnionType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.resolution.resolveType +resolveType :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Maybe Core.Type) +resolveType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.resolveType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.resolution.typeToTypeScheme +typeToTypeScheme :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.TypeScheme +typeToTypeScheme arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.typeToTypeScheme")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Rewriting.hs b/src/main/haskell/Hydra/Dsl/Rewriting.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Rewriting.hs @@ -0,0 +1,263 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.rewriting + +module Hydra.Dsl.Rewriting where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Scoping as DslScoping +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +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.Scoping as Scoping +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.rewriting.applyInsideTypeLambdasAndAnnotations +applyInsideTypeLambdasAndAnnotations :: Typed.TypedTerm (Core.Term -> Core.Term) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +applyInsideTypeLambdasAndAnnotations arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.applyInsideTypeLambdasAndAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.foldOverTerm +foldOverTerm :: Typed.TypedTerm Coders.TraversalOrder -> Typed.TypedTerm (t0 -> Core.Term -> t0) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm t0 +foldOverTerm arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.foldOverTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.rewriting.foldOverType +foldOverType :: Typed.TypedTerm Coders.TraversalOrder -> Typed.TypedTerm (t0 -> Core.Type -> t0) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Type -> Typed.TypedTerm t0 +foldOverType arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.foldOverType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.rewriting.foldTermWithGraphAndPath +foldTermWithGraphAndPath :: Typed.TypedTerm ((t0 -> Core.Term -> t0) -> [Paths.SubtermStep] -> Graph.Graph -> t0 -> Core.Term -> t0) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm t0 +foldTermWithGraphAndPath arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.foldTermWithGraphAndPath")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.rewriting.mapBeneathTypeAnnotations +mapBeneathTypeAnnotations :: Typed.TypedTerm (Core.Type -> Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +mapBeneathTypeAnnotations arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.mapBeneathTypeAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.rewriteAndFoldTerm +rewriteAndFoldTerm :: Typed.TypedTerm ((t0 -> Core.Term -> (t0, Core.Term)) -> t0 -> Core.Term -> (t0, Core.Term)) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (t0, Core.Term) +rewriteAndFoldTerm arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteAndFoldTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.rewriting.rewriteAndFoldTermWithGraph +rewriteAndFoldTermWithGraph :: Typed.TypedTerm ((t0 -> Core.Term -> (t0, Core.Term)) -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term)) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (t0, Core.Term) +rewriteAndFoldTermWithGraph arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteAndFoldTermWithGraph")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.rewriting.rewriteAndFoldTermWithGraphAndPath +rewriteAndFoldTermWithGraphAndPath :: Typed.TypedTerm ((t0 -> Core.Term -> (t0, Core.Term)) -> [Paths.SubtermStep] -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term)) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (t0, Core.Term) +rewriteAndFoldTermWithGraphAndPath arg0 arg1 arg2 arg3 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteAndFoldTermWithGraphAndPath")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})), + Core.applicationArgument = (Typed.unTypedTerm arg3)})) + +-- | DSL reference to hydra.rewriting.rewriteAndFoldTermWithPath +rewriteAndFoldTermWithPath :: Typed.TypedTerm (([Paths.SubtermStep] -> t0 -> Core.Term -> (t0, Core.Term)) -> [Paths.SubtermStep] -> t0 -> Core.Term -> (t0, Core.Term)) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (t0, Core.Term) +rewriteAndFoldTermWithPath arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteAndFoldTermWithPath")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.rewriting.rewriteTerm +rewriteTerm :: Typed.TypedTerm ((Core.Term -> Core.Term) -> Core.Term -> Core.Term) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +rewriteTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.rewriteTermM +rewriteTermM :: Typed.TypedTerm ((Core.Term -> Either t0 Core.Term) -> Core.Term -> Either t0 Core.Term) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t0 Core.Term) +rewriteTermM arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTermM")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.rewriteTermWithContext +rewriteTermWithContext :: Typed.TypedTerm ((t0 -> Core.Term -> Core.Term) -> t0 -> Core.Term -> Core.Term) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +rewriteTermWithContext arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTermWithContext")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.rewriting.rewriteTermWithContextM +rewriteTermWithContextM :: Typed.TypedTerm ((t0 -> Core.Term -> Either t1 Core.Term) -> t0 -> Core.Term -> Either t1 Core.Term) -> Typed.TypedTerm t0 -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either t1 Core.Term) +rewriteTermWithContextM arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTermWithContextM")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.rewriting.rewriteTermWithGraph +rewriteTermWithGraph :: Typed.TypedTerm ((Core.Term -> t0) -> Graph.Graph -> Core.Term -> t0) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm t0 +rewriteTermWithGraph arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTermWithGraph")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.rewriting.rewriteType +rewriteType :: Typed.TypedTerm ((Core.Type -> Core.Type) -> Core.Type -> Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +rewriteType arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.rewriteTypeM +rewriteTypeM :: Typed.TypedTerm ((Core.Type -> Either t0 Core.Type) -> Core.Type -> Either t0 Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Either t0 Core.Type) +rewriteTypeM arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.rewriteTypeM")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.rewriting.subterms +subterms :: Typed.TypedTerm Core.Term -> Typed.TypedTerm [Core.Term] +subterms arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.subterms")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.rewriting.subtermsWithSteps +subtermsWithSteps :: Typed.TypedTerm Core.Term -> Typed.TypedTerm [(Paths.SubtermStep, Core.Term)] +subtermsWithSteps arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.subtermsWithSteps")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.rewriting.subtypes +subtypes :: Typed.TypedTerm Core.Type -> Typed.TypedTerm [Core.Type] +subtypes arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.rewriting.subtypes")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Scoping.hs b/src/main/haskell/Hydra/Dsl/Scoping.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Scoping.hs @@ -0,0 +1,132 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.scoping + +module Hydra.Dsl.Scoping where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Scoping as Scoping +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.scoping.extendGraphForLambda +extendGraphForLambda :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Graph.Graph +extendGraphForLambda arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.extendGraphForLambda")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.scoping.extendGraphForLet +extendGraphForLet :: Typed.TypedTerm (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Let -> Typed.TypedTerm Graph.Graph +extendGraphForLet arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.extendGraphForLet")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.scoping.extendGraphForTypeLambda +extendGraphForTypeLambda :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Graph.Graph +extendGraphForTypeLambda arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.extendGraphForTypeLambda")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.scoping.extendGraphWithBindings +extendGraphWithBindings :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Graph.Graph +extendGraphWithBindings arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.extendGraphWithBindings")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.scoping.fTypeToTypeScheme +fTypeToTypeScheme :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.TypeScheme +fTypeToTypeScheme arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.fTypeToTypeScheme")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.scoping.termSignatureToTypeScheme +termSignatureToTypeScheme :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm Core.TypeScheme +termSignatureToTypeScheme arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.termSignatureToTypeScheme")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.scoping.typeSchemeToFType +typeSchemeToFType :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Core.Type +typeSchemeToFType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.typeSchemeToFType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.scoping.typeSchemeToTermSignature +typeSchemeToTermSignature :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Typing.TermSignature +typeSchemeToTermSignature arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.scoping.typeSchemeToTermSignature")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Serialization.hs b/src/main/haskell/Hydra/Dsl/Serialization.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Serialization.hs @@ -0,0 +1,514 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.serialization + +module Hydra.Dsl.Serialization where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Serialization as Serialization +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.serialization.angleBraces +angleBraces :: Typed.TypedTerm Ast.Brackets +angleBraces = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.angleBraces")) + +-- | DSL reference to hydra.serialization.angleBracesList +angleBracesList :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +angleBracesList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.angleBracesList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.bracesListAdaptive +bracesListAdaptive :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +bracesListAdaptive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.bracesListAdaptive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.bracketList +bracketList :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +bracketList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.bracketList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.bracketListAdaptive +bracketListAdaptive :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +bracketListAdaptive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.bracketListAdaptive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.brackets +brackets :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +brackets arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.brackets")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.chooseLayout +chooseLayout :: Typed.TypedTerm Int -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +chooseLayout arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.chooseLayout")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.commaSep +commaSep :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +commaSep arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.commaSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.commaSepAdaptive +commaSepAdaptive :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +commaSepAdaptive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.commaSepAdaptive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.cst +cst :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr +cst arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.cst")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.curlyBlock +curlyBlock :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +curlyBlock arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.curlyBlock")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.curlyBraces +curlyBraces :: Typed.TypedTerm Ast.Brackets +curlyBraces = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.curlyBraces")) + +-- | DSL reference to hydra.serialization.curlyBracesList +curlyBracesList :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +curlyBracesList arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.curlyBracesList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.customIndent +customIndent :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String +customIndent arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.customIndent")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.customIndentBlock +customIndentBlock :: Typed.TypedTerm String -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +customIndentBlock arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.customIndentBlock")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.dotSep +dotSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +dotSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.dotSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.doubleNewlineSep +doubleNewlineSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +doubleNewlineSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.doubleNewlineSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.doubleSpace +doubleSpace :: Typed.TypedTerm String +doubleSpace = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.doubleSpace")) + +-- | DSL reference to hydra.serialization.expressionLength +expressionLength :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Int +expressionLength arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.expressionLength")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.fullBlockStyle +fullBlockStyle :: Typed.TypedTerm Ast.BlockStyle +fullBlockStyle = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.fullBlockStyle")) + +-- | DSL reference to hydra.serialization.halfBlockStyle +halfBlockStyle :: Typed.TypedTerm Ast.BlockStyle +halfBlockStyle = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.halfBlockStyle")) + +-- | DSL reference to hydra.serialization.ifx +ifx :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +ifx arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.ifx")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.indent +indent :: Typed.TypedTerm String -> Typed.TypedTerm String +indent arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.indent")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.indentBlock +indentBlock :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +indentBlock arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.indentBlock")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.indentSubsequentLines +indentSubsequentLines :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +indentSubsequentLines arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.indentSubsequentLines")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.infixWs +infixWs :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +infixWs arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.infixWs")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.infixWsList +infixWsList :: Typed.TypedTerm String -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +infixWsList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.infixWsList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.inlineStyle +inlineStyle :: Typed.TypedTerm Ast.BlockStyle +inlineStyle = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.inlineStyle")) + +-- | DSL reference to hydra.serialization.maxLineWidth +maxLineWidth :: Typed.TypedTerm Int +maxLineWidth = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.maxLineWidth")) + +-- | DSL reference to hydra.serialization.newlineSep +newlineSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +newlineSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.newlineSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.noPadding +noPadding :: Typed.TypedTerm Ast.Padding +noPadding = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.noPadding")) + +-- | DSL reference to hydra.serialization.noSep +noSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +noSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.noSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.num +num :: Typed.TypedTerm Int -> Typed.TypedTerm Ast.Expr +num arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.num")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.op +op :: Typed.TypedTerm String -> Typed.TypedTerm Int -> Typed.TypedTerm Ast.Associativity -> Typed.TypedTerm Ast.Op +op arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.op")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.orOp +orOp :: Typed.TypedTerm Bool -> Typed.TypedTerm Ast.Op +orOp arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.orOp")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.orSep +orSep :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +orSep arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.orSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.parenList +parenList :: Typed.TypedTerm Bool -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +parenList arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.parenList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.parenListAdaptive +parenListAdaptive :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +parenListAdaptive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.parenListAdaptive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.parens +parens :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +parens arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.parens")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.parentheses +parentheses :: Typed.TypedTerm Ast.Brackets +parentheses = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.parentheses")) + +-- | DSL reference to hydra.serialization.parenthesize +parenthesize :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +parenthesize arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.parenthesize")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.prefix +prefix :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +prefix arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.prefix")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.printExpr +printExpr :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm String +printExpr arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.printExpr")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.semicolonSep +semicolonSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +semicolonSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.semicolonSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.sep +sep :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +sep arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.sep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.spaceSep +spaceSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +spaceSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.spaceSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.spaceSepAdaptive +spaceSepAdaptive :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +spaceSepAdaptive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.spaceSepAdaptive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.squareBrackets +squareBrackets :: Typed.TypedTerm Ast.Brackets +squareBrackets = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.serialization.squareBrackets")) + +-- | DSL reference to hydra.serialization.structuralSep +structuralSep :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +structuralSep arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.structuralSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.structuralSpaceSep +structuralSpaceSep :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +structuralSpaceSep arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.structuralSpaceSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.suffix +suffix :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +suffix arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.suffix")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.sym +sym :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Symbol +sym arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.sym")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.symbolSep +symbolSep :: Typed.TypedTerm String -> Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +symbolSep arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.symbolSep")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.serialization.tabIndent +tabIndent :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +tabIndent arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.tabIndent")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.tabIndentDoubleSpace +tabIndentDoubleSpace :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +tabIndentDoubleSpace arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.tabIndentDoubleSpace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.tabIndentSingleSpace +tabIndentSingleSpace :: Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.Expr +tabIndentSingleSpace arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.tabIndentSingleSpace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.unsupportedType +unsupportedType :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr +unsupportedType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.unsupportedType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.unsupportedVariant +unsupportedVariant :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Ast.Expr +unsupportedVariant arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.unsupportedVariant")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.serialization.withComma +withComma :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +withComma arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.withComma")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.serialization.withSemi +withSemi :: Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr +withSemi arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.serialization.withSemi")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Sorting.hs b/src/main/haskell/Hydra/Dsl/Sorting.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Sorting.hs @@ -0,0 +1,167 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.sorting + +module Hydra.Dsl.Sorting where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Constants as Constants +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Constants as DslConstants +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Sorting as Sorting +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.sorting.adjacencyListToMap +adjacencyListToMap :: Ord t0 => (Typed.TypedTerm [(t0, [t1])] -> Typed.TypedTerm (M.Map t0 [t1])) +adjacencyListToMap arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.adjacencyListToMap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.sorting.adjacencyListsToGraph +adjacencyListsToGraph :: Typed.TypedTerm [(t0, [t0])] -> Typed.TypedTerm (M.Map Int [Int], (Int -> Maybe t0)) +adjacencyListsToGraph arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.adjacencyListsToGraph")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.sorting.createOrderingIsomorphism +createOrderingIsomorphism :: Typed.TypedTerm [t0] -> Typed.TypedTerm [t0] -> Typed.TypedTerm (Topology.OrderingIsomorphism t1) +createOrderingIsomorphism arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.createOrderingIsomorphism")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.sorting.findReachableNodes +findReachableNodes :: Ord t0 => (Typed.TypedTerm (t0 -> S.Set t0) -> Typed.TypedTerm t0 -> Typed.TypedTerm (S.Set t0)) +findReachableNodes arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.findReachableNodes")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.sorting.initialState +initialState :: Typed.TypedTerm Topology.TarjanState +initialState = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.sorting.initialState")) + +-- | DSL reference to hydra.sorting.popStackUntil +popStackUntil :: Typed.TypedTerm Int -> Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm ([Int], Topology.TarjanState) +popStackUntil arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.popStackUntil")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.sorting.propagateTags +propagateTags :: Ord t1 => (Typed.TypedTerm [(t0, [t0])] -> Typed.TypedTerm [(t0, [t1])] -> Typed.TypedTerm [(t0, (S.Set t1))]) +propagateTags arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.propagateTags")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.sorting.strongConnect +strongConnect :: Typed.TypedTerm (M.Map Int [Int]) -> Typed.TypedTerm Int -> Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm Topology.TarjanState +strongConnect arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.strongConnect")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.sorting.stronglyConnectedComponents +stronglyConnectedComponents :: Typed.TypedTerm (M.Map Int [Int]) -> Typed.TypedTerm [[Int]] +stronglyConnectedComponents arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.stronglyConnectedComponents")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.sorting.topologicalSort +topologicalSort :: Typed.TypedTerm [(t0, [t0])] -> Typed.TypedTerm (Either [[t0]] [t0]) +topologicalSort arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.topologicalSort")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.sorting.topologicalSortComponents +topologicalSortComponents :: Typed.TypedTerm [(t0, [t0])] -> Typed.TypedTerm [[t0]] +topologicalSortComponents arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.topologicalSortComponents")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.sorting.topologicalSortNodes +topologicalSortNodes :: Typed.TypedTerm (t0 -> t1) -> Typed.TypedTerm (t0 -> [t1]) -> Typed.TypedTerm [t0] -> Typed.TypedTerm [[t0]] +topologicalSortNodes arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.topologicalSortNodes")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) diff --git a/src/main/haskell/Hydra/Dsl/Strip.hs b/src/main/haskell/Hydra/Dsl/Strip.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Strip.hs @@ -0,0 +1,152 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.strip + +module Hydra.Dsl.Strip where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +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.Strip as Strip +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.strip.deannotateAndDetypeTerm +deannotateAndDetypeTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +deannotateAndDetypeTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateAndDetypeTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.deannotateTerm +deannotateTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +deannotateTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.deannotateType +deannotateType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +deannotateType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.deannotateTypeParameters +deannotateTypeParameters :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +deannotateTypeParameters arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateTypeParameters")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.deannotateTypeRecursive +deannotateTypeRecursive :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +deannotateTypeRecursive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateTypeRecursive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.deannotateTypeSchemeRecursive +deannotateTypeSchemeRecursive :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Core.TypeScheme +deannotateTypeSchemeRecursive arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.deannotateTypeSchemeRecursive")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.detypeTerm +detypeTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +detypeTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.detypeTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.removeTermAnnotations +removeTermAnnotations :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +removeTermAnnotations arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.removeTermAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.removeTypeAnnotations +removeTypeAnnotations :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +removeTypeAnnotations arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.removeTypeAnnotations")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.removeTypeAnnotationsFromTerm +removeTypeAnnotationsFromTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +removeTypeAnnotationsFromTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.removeTypeAnnotationsFromTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.removeTypesFromTerm +removeTypesFromTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +removeTypesFromTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.removeTypesFromTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.strip.stripTypeLambdas +stripTypeLambdas :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +stripTypeLambdas arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.strip.stripTypeLambdas")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/System.hs b/src/main/haskell/Hydra/Dsl/System.hs --- a/src/main/haskell/Hydra/Dsl/System.hs +++ b/src/main/haskell/Hydra/Dsl/System.hs @@ -5,8 +5,10 @@ module Hydra.Dsl.System where import qualified Hydra.Core as Core +import qualified Hydra.Decode.System as DecodeSystem import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Encode.System as EncodeSystem import qualified Hydra.File as File import qualified Hydra.System as System import qualified Hydra.Typed as Typed @@ -43,6 +45,10 @@ Core.projectionFieldName = (Core.Name "arguments")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.system.Command +commandCommand :: Typed.TypedName System.Command +commandCommand = Typed.TypedName (Core.Name "hydra.system.Command") + -- | DSL accessor for the environment field of hydra.system.Command commandEnvironment :: Typed.TypedTerm System.Command -> Typed.TypedTerm (Maybe (M.Map System.EnvironmentVariable String)) commandEnvironment x = @@ -201,6 +207,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.system.EnvironmentVariable"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.system.EnvironmentVariable +environmentVariableEnvironmentVariable :: Typed.TypedName System.EnvironmentVariable +environmentVariableEnvironmentVariable = Typed.TypedName (Core.Name "hydra.system.EnvironmentVariable") + -- | DSL constructor for hydra.system.ProcessResult processResult :: Typed.TypedTerm System.StatusCode -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm System.ProcessResult processResult exitCode stdout stderr = @@ -226,6 +236,10 @@ Core.projectionFieldName = (Core.Name "exitCode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.system.ProcessResult +processResultProcessResult :: Typed.TypedName System.ProcessResult +processResultProcessResult = Typed.TypedName (Core.Name "hydra.system.ProcessResult") + -- | DSL accessor for the stderr field of hydra.system.ProcessResult processResultStderr :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm B.ByteString processResultStderr x = @@ -322,6 +336,10 @@ Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.system.StatusCode"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.system.StatusCode +statusCodeStatusCode :: Typed.TypedName System.StatusCode +statusCodeStatusCode = Typed.TypedName (Core.Name "hydra.system.StatusCode") -- | DSL accessor for the body of hydra.system.EnvironmentVariable unEnvironmentVariable :: Typed.TypedTerm System.EnvironmentVariable -> Typed.TypedTerm String diff --git a/src/main/haskell/Hydra/Dsl/Tabular.hs b/src/main/haskell/Hydra/Dsl/Tabular.hs --- a/src/main/haskell/Hydra/Dsl/Tabular.hs +++ b/src/main/haskell/Hydra/Dsl/Tabular.hs @@ -5,8 +5,12 @@ module Hydra.Dsl.Tabular where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Tabular as DecodeTabular import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Encode.Tabular as EncodeTabular +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Relational as Relational import qualified Hydra.Tabular as Tabular import qualified Hydra.Typed as Typed @@ -26,6 +30,10 @@ Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) +-- | DSL name token for hydra.tabular.ColumnType +columnTypeColumnType :: Typed.TypedName Tabular.ColumnType +columnTypeColumnType = Typed.TypedName (Core.Name "hydra.tabular.ColumnType") + -- | DSL accessor for the name field of hydra.tabular.ColumnType columnTypeName :: Typed.TypedTerm Tabular.ColumnType -> Typed.TypedTerm Relational.ColumnName columnTypeName x = @@ -85,6 +93,38 @@ Core.wrappedTermTypeName = (Core.Name "hydra.tabular.DataRow"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.tabular.DataRow +dataRowDataRow :: Typed.TypedName (Tabular.DataRow v) +dataRowDataRow = Typed.TypedName (Core.Name "hydra.tabular.DataRow") + +-- | DSL composition builder for the decoder of hydra.tabular.DataRow +decodeDataRow :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Tabular.DataRow v)) +decodeDataRow v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.tabular.dataRow")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the decoder of hydra.tabular.Table +decodeTable :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Tabular.Table v)) +decodeTable v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.tabular.table")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the encoder of hydra.tabular.DataRow +encodeDataRow :: Typed.TypedTerm (v -> Core.Term) -> Typed.TypedTerm (Tabular.DataRow v -> Core.Term) +encodeDataRow v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.tabular.dataRow")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + +-- | DSL composition builder for the encoder of hydra.tabular.Table +encodeTable :: Typed.TypedTerm (v -> Core.Term) -> Typed.TypedTerm (Tabular.Table v -> Core.Term) +encodeTable v = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.tabular.table")), + Core.applicationArgument = (Typed.unTypedTerm v)})) + -- | DSL constructor for the hydra.tabular.HeaderRow wrapper headerRow :: Typed.TypedTerm [String] -> Typed.TypedTerm Tabular.HeaderRow headerRow x = @@ -92,6 +132,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.tabular.HeaderRow"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.tabular.HeaderRow +headerRowHeaderRow :: Typed.TypedName Tabular.HeaderRow +headerRowHeaderRow = Typed.TypedName (Core.Name "hydra.tabular.HeaderRow") + -- | DSL constructor for hydra.tabular.Table table :: Typed.TypedTerm (Maybe Tabular.HeaderRow) -> Typed.TypedTerm [Tabular.DataRow v] -> Typed.TypedTerm (Tabular.Table v) table header data_ = @@ -123,6 +167,10 @@ Core.projectionFieldName = (Core.Name "header")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.tabular.Table +tableTable :: Typed.TypedName (Tabular.Table v) +tableTable = Typed.TypedName (Core.Name "hydra.tabular.Table") + -- | DSL constructor for hydra.tabular.TableType tableType :: Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm [Tabular.ColumnType] -> Typed.TypedTerm Tabular.TableType tableType name columns = @@ -153,6 +201,10 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.TableType"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.tabular.TableType +tableTypeTableType :: Typed.TypedName Tabular.TableType +tableTypeTableType = Typed.TypedName (Core.Name "hydra.tabular.TableType") -- | DSL updater for the columns field of hydra.tabular.TableType tableTypeWithColumns :: Typed.TypedTerm Tabular.TableType -> Typed.TypedTerm [Tabular.ColumnType] -> Typed.TypedTerm Tabular.TableType diff --git a/src/main/haskell/Hydra/Dsl/Test/Transform.hs b/src/main/haskell/Hydra/Dsl/Test/Transform.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Test/Transform.hs @@ -0,0 +1,172 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.test.transform + +module Hydra.Dsl.Test.Transform where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Formatting as DslFormatting +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Sorting as DslSorting +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +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.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.Sorting as Sorting +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Test.Transform as Transform +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.test.transform.addGenerationPrefix +addGenerationPrefix :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.ModuleName +addGenerationPrefix arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.addGenerationPrefix")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.buildConvertCaseCall +buildConvertCaseCall :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm String -> Typed.TypedTerm Core.Term +buildConvertCaseCall arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.buildConvertCaseCall")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.test.transform.buildTopologicalSortCall +buildTopologicalSortCall :: Typed.TypedTerm [(Int, [Int])] -> Typed.TypedTerm Core.Term +buildTopologicalSortCall arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.buildTopologicalSortCall")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.buildTopologicalSortSCCCall +buildTopologicalSortSCCCall :: Typed.TypedTerm [(Int, [Int])] -> Typed.TypedTerm Core.Term +buildTopologicalSortSCCCall arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.buildTopologicalSortSCCCall")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.collectTestCases +collectTestCases :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm [Testing.TestCaseWithMetadata] +collectTestCases arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.collectTestCases")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeAdjacencyList +encodeAdjacencyList :: Typed.TypedTerm [(Int, [Int])] -> Typed.TypedTerm Core.Term +encodeAdjacencyList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeAdjacencyList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeCaseConvention +encodeCaseConvention :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Core.Term +encodeCaseConvention arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeCaseConvention")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeEitherListList +encodeEitherListList :: Typed.TypedTerm (Either [[Int]] [Int]) -> Typed.TypedTerm Core.Term +encodeEitherListList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeEitherListList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeInt +encodeInt :: Typed.TypedTerm Int -> Typed.TypedTerm Core.Term +encodeInt arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeInt")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeIntList +encodeIntList :: Typed.TypedTerm [Int] -> Typed.TypedTerm Core.Term +encodeIntList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeIntList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.encodeListList +encodeListList :: Typed.TypedTerm [[Int]] -> Typed.TypedTerm Core.Term +encodeListList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.encodeListList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.transformModule +transformModule :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Packaging.Module +transformModule arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.transformModule")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.transformTestCase +transformTestCase :: Typed.TypedTerm t0 -> Typed.TypedTerm (Maybe t0) +transformTestCase arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.transformTestCase")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.test.transform.transformToCompiledTests +transformToCompiledTests :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm (Maybe Testing.TestGroup) +transformToCompiledTests arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.transform.transformToCompiledTests")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Test/Utils.hs b/src/main/haskell/Hydra/Dsl/Test/Utils.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Test/Utils.hs @@ -0,0 +1,97 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.test.utils + +module Hydra.Dsl.Test.Utils where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Lexical as DslLexical +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Inference as Inference +import qualified Hydra.Json.Model as Model +import qualified Hydra.Lexical as Lexical +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Test.Utils as Utils +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | DSL reference to hydra.test.utils.inferTerm +inferTerm :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Core.Term) +inferTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.utils.inferTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.test.utils.inferTestCase +inferTestCase :: Typed.TypedTerm t0 -> Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm (Either t1 Testing.TestCaseWithMetadata) +inferTestCase arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.utils.inferTestCase")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.test.utils.inferTestGroupTerms +inferTestGroupTerms :: Typed.TypedTerm t0 -> Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm (Either t1 Testing.TestGroup) +inferTestGroupTerms arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.test.utils.inferTestGroupTerms")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) diff --git a/src/main/haskell/Hydra/Dsl/Testing.hs b/src/main/haskell/Hydra/Dsl/Testing.hs --- a/src/main/haskell/Hydra/Dsl/Testing.hs +++ b/src/main/haskell/Hydra/Dsl/Testing.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Testing where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Testing as DecodeTesting import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Testing as EncodeTesting import qualified Hydra.Testing as Testing import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -33,6 +35,10 @@ Core.projectionFieldName = (Core.Name "actual")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.testing.EffectfulTestCase +effectfulTestCaseEffectfulTestCase :: Typed.TypedName Testing.EffectfulTestCase +effectfulTestCaseEffectfulTestCase = Typed.TypedName (Core.Name "hydra.testing.EffectfulTestCase") + -- | DSL accessor for the expected field of hydra.testing.EffectfulTestCase effectfulTestCaseExpected :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm (() -> String) effectfulTestCaseExpected x = @@ -83,6 +89,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.testing.Tag"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.testing.Tag +tagTag :: Typed.TypedName Testing.Tag +tagTag = Typed.TypedName (Core.Name "hydra.testing.Tag") + -- | DSL injection for the effectful variant of hydra.testing.TestCase testCaseEffectful :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm Testing.TestCase testCaseEffectful x = @@ -92,6 +102,10 @@ Core.fieldName = (Core.Name "effectful"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.testing.TestCase +testCaseTestCase :: Typed.TypedName Testing.TestCase +testCaseTestCase = Typed.TypedName (Core.Name "hydra.testing.TestCase") + -- | DSL injection for the universal variant of hydra.testing.TestCase testCaseUniversal :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm Testing.TestCase testCaseUniversal x = @@ -156,6 +170,10 @@ Core.projectionFieldName = (Core.Name "tags")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.testing.TestCaseWithMetadata +testCaseWithMetadataTestCaseWithMetadata :: Typed.TypedName Testing.TestCaseWithMetadata +testCaseWithMetadataTestCaseWithMetadata = Typed.TypedName (Core.Name "hydra.testing.TestCaseWithMetadata") + -- | DSL updater for the case field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataWithCase :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm Testing.TestCase -> Typed.TypedTerm Testing.TestCaseWithMetadata testCaseWithMetadataWithCase original newVal = @@ -335,6 +353,10 @@ Core.projectionFieldName = (Core.Name "subgroups")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.testing.TestGroup +testGroupTestGroup :: Typed.TypedName Testing.TestGroup +testGroupTestGroup = Typed.TypedName (Core.Name "hydra.testing.TestGroup") + -- | DSL updater for the cases field of hydra.testing.TestGroup testGroupWithCases :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm [Testing.TestCaseWithMetadata] -> Typed.TypedTerm Testing.TestGroup testGroupWithCases original newVal = @@ -496,6 +518,10 @@ Core.projectionTypeName = (Core.Name "hydra.testing.UniversalTestCase"), Core.projectionFieldName = (Core.Name "expected")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.testing.UniversalTestCase +universalTestCaseUniversalTestCase :: Typed.TypedName Testing.UniversalTestCase +universalTestCaseUniversalTestCase = Typed.TypedName (Core.Name "hydra.testing.UniversalTestCase") -- | DSL updater for the actual field of hydra.testing.UniversalTestCase universalTestCaseWithActual :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.UniversalTestCase diff --git a/src/main/haskell/Hydra/Dsl/Time.hs b/src/main/haskell/Hydra/Dsl/Time.hs --- a/src/main/haskell/Hydra/Dsl/Time.hs +++ b/src/main/haskell/Hydra/Dsl/Time.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Time where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Time as DecodeTime import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Time as EncodeTime import qualified Hydra.Time as Time import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -42,6 +44,10 @@ Core.projectionTypeName = (Core.Name "hydra.time.Timespec"), Core.projectionFieldName = (Core.Name "seconds")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.time.Timespec +timespecTimespec :: Typed.TypedName Time.Timespec +timespecTimespec = Typed.TypedName (Core.Name "hydra.time.Timespec") -- | DSL updater for the nanoseconds field of hydra.time.Timespec timespecWithNanoseconds :: Typed.TypedTerm Time.Timespec -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm Time.Timespec diff --git a/src/main/haskell/Hydra/Dsl/Topology.hs b/src/main/haskell/Hydra/Dsl/Topology.hs --- a/src/main/haskell/Hydra/Dsl/Topology.hs +++ b/src/main/haskell/Hydra/Dsl/Topology.hs @@ -5,7 +5,11 @@ module Hydra.Dsl.Topology where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Topology as DecodeTopology import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Topology as EncodeTopology +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Topology as Topology import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -13,6 +17,20 @@ import qualified Data.Map as M import qualified Data.Set as S +-- | DSL composition builder for the decoder of hydra.topology.OrderingIsomorphism +decodeOrderingIsomorphism :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Topology.OrderingIsomorphism a)) +decodeOrderingIsomorphism a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.topology.orderingIsomorphism")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + +-- | DSL composition builder for the encoder of hydra.topology.OrderingIsomorphism +encodeOrderingIsomorphism :: Typed.TypedTerm (a -> Core.Term) -> Typed.TypedTerm (Topology.OrderingIsomorphism a -> Core.Term) +encodeOrderingIsomorphism a = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.topology.orderingIsomorphism")), + Core.applicationArgument = (Typed.unTypedTerm a)})) + -- | DSL constructor for hydra.topology.OrderingIsomorphism orderingIsomorphism :: Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm (Topology.OrderingIsomorphism a) orderingIsomorphism encode decode = @@ -44,6 +62,10 @@ Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.topology.OrderingIsomorphism +orderingIsomorphismOrderingIsomorphism :: Typed.TypedName (Topology.OrderingIsomorphism a) +orderingIsomorphismOrderingIsomorphism = Typed.TypedName (Core.Name "hydra.topology.OrderingIsomorphism") + -- | DSL updater for the decode field of hydra.topology.OrderingIsomorphism orderingIsomorphismWithDecode :: Typed.TypedTerm (Topology.OrderingIsomorphism a) -> Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm (Topology.OrderingIsomorphism a) orderingIsomorphismWithDecode original newVal = @@ -156,6 +178,10 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "stack")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.topology.TarjanState +tarjanStateTarjanState :: Typed.TypedName Topology.TarjanState +tarjanStateTarjanState = Typed.TypedName (Core.Name "hydra.topology.TarjanState") -- | DSL updater for the counter field of hydra.topology.TarjanState tarjanStateWithCounter :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm Int -> Typed.TypedTerm Topology.TarjanState diff --git a/src/main/haskell/Hydra/Dsl/Typing.hs b/src/main/haskell/Hydra/Dsl/Typing.hs --- a/src/main/haskell/Hydra/Dsl/Typing.hs +++ b/src/main/haskell/Hydra/Dsl/Typing.hs @@ -5,8 +5,12 @@ module Hydra.Dsl.Typing where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Typing as DecodeTyping import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Encode.Typing as EncodeTyping +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Paths as Paths import qualified Hydra.Typed as Typed import qualified Hydra.Typing as Typing @@ -14,6 +18,20 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M +-- | DSL composition builder for the decoder of hydra.typing.FunctionStructure +decodeFunctionStructure :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError env) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typing.FunctionStructure env)) +decodeFunctionStructure env = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.typing.functionStructure")), + Core.applicationArgument = (Typed.unTypedTerm env)})) + +-- | DSL composition builder for the encoder of hydra.typing.FunctionStructure +encodeFunctionStructure :: Typed.TypedTerm (env -> Core.Term) -> Typed.TypedTerm (Typing.FunctionStructure env -> Core.Term) +encodeFunctionStructure env = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.typing.functionStructure")), + Core.applicationArgument = (Typed.unTypedTerm env)})) + -- | DSL constructor for hydra.typing.FunctionStructure functionStructure :: Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Maybe Core.Type) -> Typed.TypedTerm env -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructure typeParams params bindings body domains codomain environment = @@ -87,6 +105,10 @@ Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.FunctionStructure +functionStructureFunctionStructure :: Typed.TypedName (Typing.FunctionStructure env) +functionStructureFunctionStructure = Typed.TypedName (Core.Name "hydra.typing.FunctionStructure") + -- | DSL accessor for the params field of hydra.typing.FunctionStructure functionStructureParams :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Name] functionStructureParams x = @@ -491,6 +513,10 @@ Core.projectionFieldName = (Core.Name "freshTypeVariableCount")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.InferenceContext +inferenceContextInferenceContext :: Typed.TypedName Typing.InferenceContext +inferenceContextInferenceContext = Typed.TypedName (Core.Name "hydra.typing.InferenceContext") + -- | DSL accessor for the trace field of hydra.typing.InferenceContext inferenceContextTrace :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm [Paths.SubtermStep] inferenceContextTrace x = @@ -574,6 +600,10 @@ Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.InferenceResult +inferenceResultInferenceResult :: Typed.TypedName Typing.InferenceResult +inferenceResultInferenceResult = Typed.TypedName (Core.Name "hydra.typing.InferenceResult") + -- | DSL accessor for the subst field of hydra.typing.InferenceResult inferenceResultSubst :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Typing.TypeSubst inferenceResultSubst x = @@ -837,6 +867,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.Parameter +parameterParameter :: Typed.TypedName Typing.Parameter +parameterParameter = Typed.TypedName (Core.Name "hydra.typing.Parameter") + -- | DSL accessor for the type field of hydra.typing.Parameter parameterType :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Core.Type parameterType x = @@ -992,6 +1026,10 @@ Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.Result +resultResult :: Typed.TypedName Typing.Result +resultResult = Typed.TypedName (Core.Name "hydra.typing.Result") + -- | DSL accessor for the type field of hydra.typing.Result resultType :: Typed.TypedTerm Typing.Result -> Typed.TypedTerm Core.Type resultType x = @@ -1069,6 +1107,10 @@ Core.projectionFieldName = (Core.Name "result")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.TermSignature +termSignatureTermSignature :: Typed.TypedName Typing.TermSignature +termSignatureTermSignature = Typed.TypedName (Core.Name "hydra.typing.TermSignature") + -- | DSL accessor for the typeParameters field of hydra.typing.TermSignature termSignatureTypeParameters :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm [Typing.TypeParameter] termSignatureTypeParameters x = @@ -1157,6 +1199,10 @@ Core.wrappedTermTypeName = (Core.Name "hydra.typing.TermSubst"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.TermSubst +termSubstTermSubst :: Typed.TypedName Typing.TermSubst +termSubstTermSubst = Typed.TypedName (Core.Name "hydra.typing.TermSubst") + -- | DSL constructor for hydra.typing.TypeClass typeClass :: Typed.TypedTerm String -> Typed.TypedTerm Typing.TypeClass typeClass description = @@ -1176,6 +1222,10 @@ Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.TypeClass +typeClassTypeClass :: Typed.TypedName Typing.TypeClass +typeClassTypeClass = Typed.TypedName (Core.Name "hydra.typing.TypeClass") + -- | DSL updater for the description field of hydra.typing.TypeClass typeClassWithDescription :: Typed.TypedTerm Typing.TypeClass -> Typed.TypedTerm String -> Typed.TypedTerm Typing.TypeClass typeClassWithDescription original newVal = @@ -1229,6 +1279,10 @@ Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.TypeConstraint +typeConstraintTypeConstraint :: Typed.TypedName Typing.TypeConstraint +typeConstraintTypeConstraint = Typed.TypedName (Core.Name "hydra.typing.TypeConstraint") + -- | DSL updater for the comment field of hydra.typing.TypeConstraint typeConstraintWithComment :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm String -> Typed.TypedTerm Typing.TypeConstraint typeConstraintWithComment original newVal = @@ -1332,6 +1386,10 @@ Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.typing.TypeParameter +typeParameterTypeParameter :: Typed.TypedName Typing.TypeParameter +typeParameterTypeParameter = Typed.TypedName (Core.Name "hydra.typing.TypeParameter") + -- | DSL updater for the constraints field of hydra.typing.TypeParameter typeParameterWithConstraints :: Typed.TypedTerm Typing.TypeParameter -> Typed.TypedTerm [Core.TypeClassConstraint] -> Typed.TypedTerm Typing.TypeParameter typeParameterWithConstraints original newVal = @@ -1372,6 +1430,10 @@ Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.typing.TypeSubst"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.typing.TypeSubst +typeSubstTypeSubst :: Typed.TypedName Typing.TypeSubst +typeSubstTypeSubst = Typed.TypedName (Core.Name "hydra.typing.TypeSubst") -- | DSL accessor for the body of hydra.typing.TermSubst unTermSubst :: Typed.TypedTerm Typing.TermSubst -> Typed.TypedTerm (M.Map Core.Name Core.Term) diff --git a/src/main/haskell/Hydra/Dsl/Util.hs b/src/main/haskell/Hydra/Dsl/Util.hs --- a/src/main/haskell/Hydra/Dsl/Util.hs +++ b/src/main/haskell/Hydra/Dsl/Util.hs @@ -5,8 +5,12 @@ module Hydra.Dsl.Util where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Util as DecodeUtil import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Encode.Util as EncodeUtil +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Packaging as Packaging import qualified Hydra.Typed as Typed import qualified Hydra.Util as Util @@ -23,6 +27,10 @@ Core.fieldName = (Core.Name "camel"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.util.CaseConvention +caseConventionCaseConvention :: Typed.TypedName Util.CaseConvention +caseConventionCaseConvention = Typed.TypedName (Core.Name "hydra.util.CaseConvention") + -- | DSL injection for the lowerSnake variant of hydra.util.CaseConvention caseConventionLowerSnake :: Typed.TypedTerm Util.CaseConvention caseConventionLowerSnake = @@ -50,6 +58,10 @@ Core.fieldName = (Core.Name "upperSnake"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.util.Comparison +comparisonComparison :: Typed.TypedName Util.Comparison +comparisonComparison = Typed.TypedName (Core.Name "hydra.util.Comparison") + -- | DSL injection for the equalTo variant of hydra.util.Comparison comparisonEqualTo :: Typed.TypedTerm Util.Comparison comparisonEqualTo = @@ -77,6 +89,20 @@ Core.fieldName = (Core.Name "lessThan"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL composition builder for the decoder of hydra.util.ModuleNames +decodeModuleNames :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError n) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Util.ModuleNames n)) +decodeModuleNames n = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.util.moduleNames")), + Core.applicationArgument = (Typed.unTypedTerm n)})) + +-- | DSL composition builder for the encoder of hydra.util.ModuleNames +encodeModuleNames :: Typed.TypedTerm (n -> Core.Term) -> Typed.TypedTerm (Util.ModuleNames n -> Core.Term) +encodeModuleNames n = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.util.moduleNames")), + Core.applicationArgument = (Typed.unTypedTerm n)})) + -- | DSL constructor for hydra.util.ModuleNames moduleNames :: Typed.TypedTerm (Packaging.ModuleName, n) -> Typed.TypedTerm (M.Map Packaging.ModuleName n) -> Typed.TypedTerm (Util.ModuleNames n) moduleNames focus mapping = @@ -108,6 +134,10 @@ Core.projectionFieldName = (Core.Name "mapping")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.util.ModuleNames +moduleNamesModuleNames :: Typed.TypedName (Util.ModuleNames n) +moduleNamesModuleNames = Typed.TypedName (Core.Name "hydra.util.ModuleNames") + -- | DSL updater for the focus field of hydra.util.ModuleNames moduleNamesWithFocus :: Typed.TypedTerm (Util.ModuleNames n) -> Typed.TypedTerm (Packaging.ModuleName, n) -> Typed.TypedTerm (Util.ModuleNames n) moduleNamesWithFocus original newVal = @@ -160,6 +190,10 @@ Core.fieldName = (Core.Name "bits"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.util.Precision +precisionPrecision :: Typed.TypedName Util.Precision +precisionPrecision = Typed.TypedName (Core.Name "hydra.util.Precision") + -- | DSL constructor for hydra.util.QualifiedName qualifiedName :: Typed.TypedTerm (Maybe Packaging.ModuleName) -> Typed.TypedTerm String -> Typed.TypedTerm Util.QualifiedName qualifiedName moduleName local = @@ -190,6 +224,10 @@ Core.projectionTypeName = (Core.Name "hydra.util.QualifiedName"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.util.QualifiedName +qualifiedNameQualifiedName :: Typed.TypedName Util.QualifiedName +qualifiedNameQualifiedName = Typed.TypedName (Core.Name "hydra.util.QualifiedName") -- | DSL updater for the local field of hydra.util.QualifiedName qualifiedNameWithLocal :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm String -> Typed.TypedTerm Util.QualifiedName diff --git a/src/main/haskell/Hydra/Dsl/Validation.hs b/src/main/haskell/Hydra/Dsl/Validation.hs --- a/src/main/haskell/Hydra/Dsl/Validation.hs +++ b/src/main/haskell/Hydra/Dsl/Validation.hs @@ -5,15 +5,33 @@ module Hydra.Dsl.Validation where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Validation as DecodeValidation import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Encode.Validation as EncodeValidation import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Errors as Errors +import qualified Hydra.Graph as Graph import qualified Hydra.Typed as Typed import qualified Hydra.Validation as Validation import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S +-- | DSL composition builder for the decoder of hydra.validation.ValidationResult +decodeValidationResult :: Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError e) -> Typed.TypedTerm (Graph.Graph -> Core.Term -> Either Errors.DecodingError (Validation.ValidationResult e)) +decodeValidationResult e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.decode.validation.validationResult")), + Core.applicationArgument = (Typed.unTypedTerm e)})) + +-- | DSL composition builder for the encoder of hydra.validation.ValidationResult +encodeValidationResult :: Typed.TypedTerm (e -> Core.Term) -> Typed.TypedTerm (Validation.ValidationResult e -> Core.Term) +encodeValidationResult e = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.encode.validation.validationResult")), + Core.applicationArgument = (Typed.unTypedTerm e)})) + -- | DSL constructor for hydra.validation.ValidationProfile validationProfile :: Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Validation.ValidationProfile validationProfile errorRules warningRules maxErrors maxWarnings = @@ -60,6 +78,10 @@ Core.projectionFieldName = (Core.Name "maxWarnings")})), Core.applicationArgument = (Typed.unTypedTerm x)})) +-- | DSL name token for hydra.validation.ValidationProfile +validationProfileValidationProfile :: Typed.TypedName Validation.ValidationProfile +validationProfileValidationProfile = Typed.TypedName (Core.Name "hydra.validation.ValidationProfile") + -- | DSL accessor for the warningRules field of hydra.validation.ValidationProfile validationProfileWarningRules :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm (S.Set Core.Name) validationProfileWarningRules x = @@ -214,6 +236,10 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationResult"), Core.projectionFieldName = (Core.Name "errors")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL name token for hydra.validation.ValidationResult +validationResultValidationResult :: Typed.TypedName (Validation.ValidationResult e) +validationResultValidationResult = Typed.TypedName (Core.Name "hydra.validation.ValidationResult") -- | DSL accessor for the warnings field of hydra.validation.ValidationResult validationResultWarnings :: Typed.TypedTerm (Validation.ValidationResult e) -> Typed.TypedTerm [e] diff --git a/src/main/haskell/Hydra/Dsl/Variables.hs b/src/main/haskell/Hydra/Dsl/Variables.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Variables.hs @@ -0,0 +1,195 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.variables + +module Hydra.Dsl.Variables where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Ast as DslAst +import qualified Hydra.Dsl.Coders as DslCoders +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Docs as DslDocs +import qualified Hydra.Dsl.Error.Checking as ErrorChecking +import qualified Hydra.Dsl.Error.Core as DslErrorCore +import qualified Hydra.Dsl.Error.File as DslErrorFile +import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging +import qualified Hydra.Dsl.Error.System as DslErrorSystem +import qualified Hydra.Dsl.Errors as DslErrors +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Dsl.Graph as DslGraph +import qualified Hydra.Dsl.Json.Model as JsonModel +import qualified Hydra.Dsl.Names as DslNames +import qualified Hydra.Dsl.Packaging as DslPackaging +import qualified Hydra.Dsl.Parsing as DslParsing +import qualified Hydra.Dsl.Paths as DslPaths +import qualified Hydra.Dsl.Query as DslQuery +import qualified Hydra.Dsl.Regex as DslRegex +import qualified Hydra.Dsl.Relational as DslRelational +import qualified Hydra.Dsl.Rewriting as DslRewriting +import qualified Hydra.Dsl.System as DslSystem +import qualified Hydra.Dsl.Tabular as DslTabular +import qualified Hydra.Dsl.Testing as DslTesting +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.Dsl.Topology as DslTopology +import qualified Hydra.Dsl.Typing as DslTyping +import qualified Hydra.Dsl.Util as DslUtil +import qualified Hydra.Dsl.Validation as DslValidation +import qualified Hydra.Dsl.Variants as DslVariants +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +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.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | DSL reference to hydra.variables.freeTypeVariablesInTerm +freeTypeVariablesInTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (S.Set Core.Name) +freeTypeVariablesInTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeTypeVariablesInTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInTerm +freeVariablesInTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (S.Set Core.Name) +freeVariablesInTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInType +freeVariablesInType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm (S.Set Core.Name) +freeVariablesInType arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInType")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInTypeOrdered +freeVariablesInTypeOrdered :: Typed.TypedTerm Core.Type -> Typed.TypedTerm [Core.Name] +freeVariablesInTypeOrdered arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInTypeOrdered")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInTypeScheme +freeVariablesInTypeScheme :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm (S.Set Core.Name) +freeVariablesInTypeScheme arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInTypeScheme")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInTypeSchemeSimple +freeVariablesInTypeSchemeSimple :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm (S.Set Core.Name) +freeVariablesInTypeSchemeSimple arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInTypeSchemeSimple")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.freeVariablesInTypeSimple +freeVariablesInTypeSimple :: Typed.TypedTerm Core.Type -> Typed.TypedTerm (S.Set Core.Name) +freeVariablesInTypeSimple arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.freeVariablesInTypeSimple")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.isFreeVariableInTerm +isFreeVariableInTerm :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Bool +isFreeVariableInTerm arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.isFreeVariableInTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.variables.normalizeTypeVariablesInTerm +normalizeTypeVariablesInTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +normalizeTypeVariablesInTerm arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.normalizeTypeVariablesInTerm")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.variables.replaceFreeTermVariable +replaceFreeTermVariable :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +replaceFreeTermVariable arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.replaceFreeTermVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.variables.replaceFreeTypeVariable +replaceFreeTypeVariable :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +replaceFreeTypeVariable arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.replaceFreeTypeVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.variables.substituteTypeVariables +substituteTypeVariables :: Typed.TypedTerm (M.Map Core.Name Core.Name) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +substituteTypeVariables arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.substituteTypeVariables")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.variables.substituteVariable +substituteVariable :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +substituteVariable arg0 arg1 arg2 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.substituteVariable")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.variables.substituteVariables +substituteVariables :: Typed.TypedTerm (M.Map Core.Name Core.Name) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +substituteVariables arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.substituteVariables")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.variables.unshadowVariables +unshadowVariables :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term +unshadowVariables arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.variables.unshadowVariables")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Variants.hs b/src/main/haskell/Hydra/Dsl/Variants.hs --- a/src/main/haskell/Hydra/Dsl/Variants.hs +++ b/src/main/haskell/Hydra/Dsl/Variants.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Variants where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Variants as DecodeVariants import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Variants as EncodeVariants import qualified Hydra.Typed as Typed import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -56,6 +58,10 @@ Core.fieldName = (Core.Name "integer"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.variants.LiteralVariant +literalVariantLiteralVariant :: Typed.TypedName Variants.LiteralVariant +literalVariantLiteralVariant = Typed.TypedName (Core.Name "hydra.variants.LiteralVariant") + -- | DSL injection for the string variant of hydra.variants.LiteralVariant literalVariantString :: Typed.TypedTerm Variants.LiteralVariant literalVariantString = @@ -200,6 +206,10 @@ Core.fieldName = (Core.Name "set"), Core.fieldTerm = Core.TermUnit}})) +-- | DSL name token for hydra.variants.TermVariant +termVariantTermVariant :: Typed.TypedName Variants.TermVariant +termVariantTermVariant = Typed.TypedName (Core.Name "hydra.variants.TermVariant") + -- | DSL injection for the typeApplication variant of hydra.variants.TermVariant termVariantTypeApplication :: Typed.TypedTerm Variants.TermVariant termVariantTypeApplication = @@ -370,6 +380,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.variants.TypeVariant +typeVariantTypeVariant :: Typed.TypedName Variants.TypeVariant +typeVariantTypeVariant = Typed.TypedName (Core.Name "hydra.variants.TypeVariant") -- | DSL injection for the union variant of hydra.variants.TypeVariant typeVariantUnion :: Typed.TypedTerm Variants.TypeVariant diff --git a/src/main/haskell/Hydra/Dsl/Yaml/Model.hs b/src/main/haskell/Hydra/Dsl/Yaml/Model.hs --- a/src/main/haskell/Hydra/Dsl/Yaml/Model.hs +++ b/src/main/haskell/Hydra/Dsl/Yaml/Model.hs @@ -5,7 +5,9 @@ module Hydra.Dsl.Yaml.Model where import qualified Hydra.Core as Core +import qualified Hydra.Decode.Yaml.Model as DecodeYamlModel import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Encode.Yaml.Model as EncodeYamlModel import qualified Hydra.Typed as Typed import qualified Hydra.Yaml.Model as Model import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -21,6 +23,10 @@ Core.fieldName = (Core.Name "mapping"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL name token for hydra.yaml.model.Node +nodeNode :: Typed.TypedName Model.Node +nodeNode = Typed.TypedName (Core.Name "hydra.yaml.model.Node") + -- | DSL injection for the scalar variant of hydra.yaml.model.Node nodeScalar :: Typed.TypedTerm Model.Scalar -> Typed.TypedTerm Model.Node nodeScalar x = @@ -83,6 +89,10 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "null"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL name token for hydra.yaml.model.Scalar +scalarScalar :: Typed.TypedName Model.Scalar +scalarScalar = Typed.TypedName (Core.Name "hydra.yaml.model.Scalar") -- | DSL injection for the str variant of hydra.yaml.model.Scalar scalarStr :: Typed.TypedTerm String -> Typed.TypedTerm Model.Scalar diff --git a/src/main/haskell/Hydra/Dsls.hs b/src/main/haskell/Hydra/Dsls.hs --- a/src/main/haskell/Hydra/Dsls.hs +++ b/src/main/haskell/Hydra/Dsls.hs @@ -37,6 +37,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping import qualified Hydra.Strip as Strip @@ -75,42 +76,22 @@ -- | Generate a binding name for a DSL function from a type name dslBindingName :: Core.Name -> Core.Name -dslBindingName n = - - let parts = Strings.splitOn "." (Core.unName n) - localPart = Formatting.decapitalize (Names.localNameOf n) - localResult = Core.Name localPart - in (Optionals.cases (Lists.maybeInit parts) localResult (\nsParts -> Optionals.cases (Lists.uncons nsParts) localResult (\nsHeadTail -> - let dslNsParts = - Logic.ifElse (Equality.equal (Pairs.first nsHeadTail) "hydra") (Lists.concat2 [ - "hydra", - "dsl"] (Pairs.second nsHeadTail)) (Lists.concat2 [ - "hydra", - "dsl"] nsParts) - in (Core.Name (Strings.intercalate "." (Lists.concat2 dslNsParts [ - localPart])))))) +dslBindingName = + Names.derivedBindingName [ + "hydra", + "dsl"] False -- | Generate a qualified DSL element name from a type name and local element name dslDefinitionName :: Core.Name -> String -> Core.Name -dslDefinitionName typeName localName = - - let parts = Strings.splitOn "." (Core.unName typeName) - in (Optionals.cases (Lists.maybeInit parts) (Core.Name localName) (\nsParts -> - let dslNsParts = - Optionals.cases (Lists.uncons nsParts) [ - "hydra", - "dsl"] (\nsHeadTail -> Logic.ifElse (Equality.equal (Pairs.first nsHeadTail) "hydra") (Lists.concat2 [ - "hydra", - "dsl"] (Pairs.second nsHeadTail)) (Lists.concat2 [ - "hydra", - "dsl"] nsParts)) - in (Core.Name (Strings.intercalate "." (Lists.concat2 dslNsParts [ - localName]))))) +dslDefinitionName = + Names.derivedDefinitionName [ + "hydra", + "dsl"] False True -- | Transform a source module into a DSL module dslModule :: t0 -> Graph.Graph -> Packaging.Module -> Either Errors.Error (Maybe Packaging.Module) dslModule cx graph mod = - Eithers.bind (filterTypeBindings cx graph (Optionals.cat (Lists.map (\d -> case d of + Eithers.bind (filterTypeBindings cx graph (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -130,7 +111,7 @@ in (Logic.ifElse (Lists.null allBindings) (Right Nothing) (Right (Just (Packaging.Module { Packaging.moduleName = (dslModuleName (Packaging.moduleName mod)), Packaging.moduleMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just (Strings.cat [ + Packaging.entityMetadataDescription = (Just (Strings.concat [ "DSL functions for ", (Packaging.unModuleName (Packaging.moduleName mod))])), Packaging.entityMetadataComments = [], @@ -138,9 +119,15 @@ Packaging.entityMetadataLifecycle = Nothing})), Packaging.moduleDependencies = (Lists.map (\ns -> Packaging.ModuleDependency { Packaging.moduleDependencyModule = ns, - Packaging.moduleDependencyPackage = Nothing}) (Lists.nub (Lists.concat2 [ + Packaging.moduleDependencyPackage = Nothing}) (Lists.distinct (Lists.concat2 [ Packaging.moduleName mod, - (Packaging.ModuleName "hydra.typed")] (Lists.concat2 (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod)) (Lists.map dslModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))))))), + (Packaging.ModuleName "hydra.typed"), + (Names.derivedModuleName [ + "hydra", + "encode"] True (Packaging.moduleName mod)), + (Names.derivedModuleName [ + "hydra", + "decode"] True (Packaging.moduleName mod))] (Lists.concat2 (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod)) (Lists.map dslModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))))))), Packaging.moduleDefinitions = (Lists.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { Packaging.termDefinitionName = (Core.bindingName b), Packaging.termDefinitionMetadata = Nothing, @@ -149,16 +136,10 @@ -- | Generate a DSL module name from a source module name dslModuleName :: Packaging.ModuleName -> Packaging.ModuleName -dslModuleName ns = - - let parts = Strings.splitOn "." (Packaging.unModuleName ns) - prefixFull = - Packaging.ModuleName (Strings.cat [ - "hydra.dsl.", - (Packaging.unModuleName ns)]) - in (Optionals.cases (Lists.uncons parts) prefixFull (\ht -> Logic.ifElse (Equality.equal (Pairs.first ht) "hydra") (Packaging.ModuleName (Strings.cat [ - "hydra.dsl.", - (Strings.intercalate "." (Pairs.second ht))])) prefixFull)) +dslModuleName = + Names.derivedModuleName [ + "hydra", + "dsl"] False -- | Build a TypedTerm-wrapped TypeScheme (functions of phantom terms) from a TermSignature dslSignatureTypeScheme :: Typing.TermSignature -> Core.TypeScheme @@ -205,7 +186,7 @@ -- | Filter bindings to only DSL-eligible type definitions filterTypeBindings :: t0 -> t1 -> [Core.Binding] -> Either t2 [Core.Binding] filterTypeBindings cx graph bindings = - Eithers.map Optionals.cat (Eithers.mapList (isDslEligibleBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) + Eithers.map Optionals.givens (Eithers.mapList (isDslEligibleBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) -- | Generate all DSL bindings for a type binding generateBindingsForType :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.DecodingError [Core.Binding] @@ -216,22 +197,194 @@ let typ = Strip.deannotateTypeParameters (Strip.deannotateType rawType) in (Right (case typ of Core.TypeRecord v0 -> Lists.concat [ - generateRecordConstructor rawType typeName v0, + [ + generateTypeNameToken rawType typeName], + (generateParametricRefBuilders rawType typeName), + (generateRecordConstructor rawType typeName v0), (Lists.map (generateRecordAccessor rawType typeName) v0), (Lists.map (generateRecordWithUpdater rawType typeName v0) v0)] - Core.TypeUnion v0 -> Lists.map (generateUnionInjector rawType typeName) v0 - Core.TypeWrap v0 -> generateWrappedTypeAccessors rawType typeName v0 + Core.TypeUnion v0 -> Lists.concat [ + [ + generateTypeNameToken rawType typeName], + (generateParametricRefBuilders rawType typeName), + (Lists.map (generateUnionInjector rawType typeName) v0)] + Core.TypeWrap v0 -> Lists.concat [ + [ + generateTypeNameToken rawType typeName], + (generateParametricRefBuilders rawType typeName), + (generateWrappedTypeAccessors rawType typeName v0)] _ -> [])))) +-- | Generate encode/decode composition builders for a parametric type definition +generateParametricRefBuilders :: Core.Type -> Core.Name -> [Core.Binding] +generateParametricRefBuilders origType typeName = + + let vars = collectForallVars origType + in (Logic.ifElse (Lists.null vars) [] [ + + let vars = collectForallVars origType + localName = Names.localNameOf typeName + builderLocalName = + Strings.concat [ + "encode", + localName] + builderName = dslDefinitionName typeName builderLocalName + refName = + Names.derivedBindingName [ + "hydra", + "encode"] True typeName + paramPairs = + Lists.map (\v -> ( + Core.unName v, + (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedTerm")), + Core.applicationTypeArgument = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable v), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))})))) vars + appBody = + Lists.foldl (\acc -> \pp -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "application"), + Core.fieldTerm = (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.core.Application"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "function"), + Core.fieldTerm = acc}, + Core.Field { + Core.fieldName = (Core.Name "argument"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typed.TypedTerm")), + Core.applicationArgument = (Core.TermVariable (Core.Name (Pairs.first pp)))}))}]}))}})) (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "variable"), + Core.fieldTerm = (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Core.unName refName)))}))}})) paramPairs + builderTerm = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.typed.TypedTerm"), + Core.wrappedTermBody = appBody}) + rawBody = + Lists.foldl (\acc -> \pp -> Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name (Pairs.first pp)), + Core.lambdaDomain = (Just (Pairs.second pp)), + Core.lambdaBody = acc})) builderTerm (Lists.reverse paramPairs) + description = + Strings.concat [ + "DSL composition builder for the ", + "encode", + "r of ", + (Core.unName typeName)] + body = Annotations.setTermDescription (Just description) rawBody + resultType = nominalResultType typeName origType + paramTypes = + Lists.map (\v -> Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable v), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))})) vars + ts = + dslTypeScheme origType paramTypes (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = resultType, + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))})) + in Core.Binding { + Core.bindingName = builderName, + Core.bindingTerm = body, + Core.bindingTypeScheme = (Just ts)}, + + let vars = collectForallVars origType + localName = Names.localNameOf typeName + builderLocalName = + Strings.concat [ + "decode", + localName] + builderName = dslDefinitionName typeName builderLocalName + refName = + Names.derivedBindingName [ + "hydra", + "decode"] True typeName + paramPairs = + Lists.map (\v -> ( + Core.unName v, + (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedTerm")), + Core.applicationTypeArgument = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.graph.Graph")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.core.Term")), + Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), + Core.eitherTypeRight = (Core.TypeVariable v)}))}))}))})))) vars + appBody = + Lists.foldl (\acc -> \pp -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "application"), + Core.fieldTerm = (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.core.Application"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "function"), + Core.fieldTerm = acc}, + Core.Field { + Core.fieldName = (Core.Name "argument"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typed.TypedTerm")), + Core.applicationArgument = (Core.TermVariable (Core.Name (Pairs.first pp)))}))}]}))}})) (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "variable"), + Core.fieldTerm = (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Core.unName refName)))}))}})) paramPairs + builderTerm = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.typed.TypedTerm"), + Core.wrappedTermBody = appBody}) + rawBody = + Lists.foldl (\acc -> \pp -> Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name (Pairs.first pp)), + Core.lambdaDomain = (Just (Pairs.second pp)), + Core.lambdaBody = acc})) builderTerm (Lists.reverse paramPairs) + description = + Strings.concat [ + "DSL composition builder for the ", + "decode", + "r of ", + (Core.unName typeName)] + body = Annotations.setTermDescription (Just description) rawBody + resultType = nominalResultType typeName origType + paramTypes = + Lists.map (\v -> Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.graph.Graph")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.core.Term")), + Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), + Core.eitherTypeRight = (Core.TypeVariable v)}))}))})) vars + ts = + dslTypeScheme origType paramTypes (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.graph.Graph")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.core.Term")), + Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), + Core.eitherTypeRight = resultType}))}))})) + in Core.Binding { + Core.bindingName = builderName, + Core.bindingTerm = body, + Core.bindingTypeScheme = (Just ts)}]) + -- | Generate a record field accessor function generateRecordAccessor :: Core.Type -> Core.Name -> Core.FieldType -> Core.Binding generateRecordAccessor origType typeName ft = let fieldName = Core.fieldTypeName ft accessorLocalName = - Strings.cat [ + Strings.concat [ Formatting.decapitalize (Names.localNameOf typeName), - (Strings.intercalate "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName fieldName))))] + (Strings.join "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName fieldName))))] accessorName = dslDefinitionName typeName accessorLocalName paramDomain = Core.TypeApplication (Core.ApplicationType { @@ -275,7 +428,7 @@ Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typed.TypedTerm")), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}]}))}}))}))}) description = - Strings.cat [ + Strings.concat [ "DSL accessor for the ", (Core.unName fieldName), " field of ", @@ -336,7 +489,7 @@ Core.lambdaDomain = (Just (Pairs.second pp)), Core.lambdaBody = acc})) recordTerm (Lists.reverse paramPairs) description = - Strings.cat [ + Strings.concat [ "DSL constructor for ", (Core.unName typeName)] body = Annotations.setTermDescription (Just description) rawBody @@ -355,10 +508,10 @@ let targetFieldName = Core.fieldTypeName targetField updaterLocalName = - Strings.cat [ + Strings.concat [ Formatting.decapitalize (Names.localNameOf typeName), "With", - (Strings.intercalate "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName targetFieldName))))] + (Strings.join "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName targetFieldName))))] updaterName = dslDefinitionName typeName updaterLocalName dFields = Lists.map (\ft -> Core.TermRecord (Core.Record { @@ -437,7 +590,7 @@ Core.fieldName = (Core.Name "fields"), Core.fieldTerm = (Core.TermList dFields)}]}))}}))}))}))}) description = - Strings.cat [ + Strings.concat [ "DSL updater for the ", (Core.unName targetFieldName), " field of ", @@ -507,7 +660,7 @@ Core.lambdaDomain = (Just (Pairs.second pp)), Core.lambdaBody = acc})) refTerm (Lists.reverse paramPairs) description = - Strings.cat [ + Strings.concat [ "DSL reference to ", (Core.unName refName)] body = Annotations.setTermDescription (Just description) rawBody @@ -517,6 +670,38 @@ Core.bindingTerm = body, Core.bindingTypeScheme = (Just ts)} +-- | Generate a TypedName token constant for a type definition +generateTypeNameToken :: Core.Type -> Core.Name -> Core.Binding +generateTypeNameToken origType typeName = + + let localName = Names.localNameOf typeName + tokenLocalName = + Strings.concat [ + Formatting.decapitalize localName, + localName] + tokenName = dslDefinitionName typeName tokenLocalName + description = + Strings.concat [ + "DSL name token for ", + (Core.unName typeName)] + body = + Annotations.setTermDescription (Just description) (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.typed.TypedName"), + Core.wrappedTermBody = (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), + Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Core.unName typeName)))}))})) + ts = + Core.TypeScheme { + Core.typeSchemeVariables = (collectForallVars origType), + Core.typeSchemeBody = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedName")), + Core.applicationTypeArgument = (nominalResultType typeName origType)})), + Core.typeSchemeConstraints = Nothing} + in Core.Binding { + Core.bindingName = tokenName, + Core.bindingTerm = body, + Core.bindingTypeScheme = (Just ts)} + -- | Generate a union injection helper generateUnionInjector :: Core.Type -> Core.Name -> Core.FieldType -> Core.Binding generateUnionInjector origType typeName ft = @@ -524,9 +709,9 @@ let fieldName = Core.fieldTypeName ft fieldType = Core.fieldTypeType ft injectorLocalName = - Strings.cat [ + Strings.concat [ Formatting.decapitalize (Names.localNameOf typeName), - (Strings.intercalate "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName fieldName))))] + (Strings.join "" (Lists.map (\s -> Formatting.capitalize s) (Strings.splitOn "." (Core.unName fieldName))))] injectorName = dslDefinitionName typeName injectorLocalName isUnit = (\t -> case (Strip.deannotateType t) of @@ -578,7 +763,7 @@ Core.lambdaDomain = (Just variantDomain), Core.lambdaBody = injectionTerm})) description = - Strings.cat [ + Strings.concat [ "DSL injection for the ", (Core.unName fieldName), " variant of ", @@ -599,7 +784,7 @@ let localName = Names.localNameOf typeName wrapName = dslDefinitionName typeName (Formatting.decapitalize localName) unwrapLocalName = - Strings.cat [ + Strings.concat [ "un", localName] unwrapName = dslDefinitionName typeName unwrapLocalName @@ -632,7 +817,7 @@ Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typed.TypedTerm")), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}]}))}}))}))}) wrapDescription = - Strings.cat [ + Strings.concat [ "DSL constructor for the ", (Core.unName typeName), " wrapper"] @@ -669,7 +854,7 @@ Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typed.TypedTerm")), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}]}))}}))}))}) unwrapDescription = - Strings.cat [ + Strings.concat [ "DSL accessor for the body of ", (Core.unName typeName)] unwrapBody = Annotations.setTermDescription (Just unwrapDescription) rawUnwrapBody diff --git a/src/main/haskell/Hydra/Encode/Error/Core.hs b/src/main/haskell/Hydra/Encode/Error/Core.hs --- a/src/main/haskell/Hydra/Encode/Error/Core.hs +++ b/src/main/haskell/Hydra/Encode/Error/Core.hs @@ -9,6 +9,7 @@ import qualified Hydra.Encode.Paths as Paths import qualified Hydra.Encode.Variants as Variants import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci @@ -253,6 +254,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidTypeLambdaParameterName"), Core.fieldTerm = (invalidTypeLambdaParameterNameError v0)}}) + ErrorCore.InvalidTermErrorMissingCaseBranches v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "missingCaseBranches"), + Core.fieldTerm = (missingCaseBranchesError v0)}}) ErrorCore.InvalidTermErrorNestedTermAnnotation v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field { @@ -298,6 +304,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTypeVariableInTypeApplication"), Core.fieldTerm = (undefinedTypeVariableInTypeApplicationError v0)}}) + ErrorCore.InvalidTermErrorUnknownCaseAlternative v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "unknownCaseAlternative"), + Core.fieldTerm = (unknownCaseAlternativeError v0)}}) ErrorCore.InvalidTermErrorUnknownPrimitiveName v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field { @@ -428,6 +439,22 @@ Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (EncodeCore.literalType (ErrorCore.literalTypeMismatchErrorActualType x))}]}) +-- | Encoder for hydra.error.core.MissingCaseBranchesError +missingCaseBranchesError :: ErrorCore.MissingCaseBranchesError -> Core.Term +missingCaseBranchesError x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.MissingCaseBranchesError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Paths.subtermPath (ErrorCore.missingCaseBranchesErrorLocation x))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (EncodeCore.name (ErrorCore.missingCaseBranchesErrorTypeName x))}, + Core.Field { + Core.fieldName = (Core.Name "variantNames"), + Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.name xs)) (ErrorCore.missingCaseBranchesErrorVariantNames x))}]}) + -- | Encoder for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: ErrorCore.NestedTermAnnotationError -> Core.Term nestedTermAnnotationError x = @@ -655,6 +682,22 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (EncodeCore.type_ (ErrorCore.unexpectedTypeVariantErrorActualType x))}]}) + +-- | Encoder for hydra.error.core.UnknownCaseAlternativeError +unknownCaseAlternativeError :: ErrorCore.UnknownCaseAlternativeError -> Core.Term +unknownCaseAlternativeError x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.core.UnknownCaseAlternativeError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "location"), + Core.fieldTerm = (Paths.subtermPath (ErrorCore.unknownCaseAlternativeErrorLocation x))}, + Core.Field { + Core.fieldName = (Core.Name "typeName"), + Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownCaseAlternativeErrorTypeName x))}, + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownCaseAlternativeErrorName x))}]}) -- | Encoder for hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameError :: ErrorCore.UnknownPrimitiveNameError -> Core.Term diff --git a/src/main/haskell/Hydra/Encode/Error/Packaging.hs b/src/main/haskell/Hydra/Encode/Error/Packaging.hs --- a/src/main/haskell/Hydra/Encode/Error/Packaging.hs +++ b/src/main/haskell/Hydra/Encode/Error/Packaging.hs @@ -186,6 +186,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidPackageName"), Core.fieldTerm = (invalidPackageNameError v0)}}) + ErrorPackaging.InvalidPackageErrorUndeclaredDependency v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.packaging.InvalidPackageError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "undeclaredDependency"), + Core.fieldTerm = (undeclaredDependencyError v0)}}) -- | Encoder for hydra.error.packaging.InvalidPackageNameError invalidPackageNameError :: ErrorPackaging.InvalidPackageNameError -> Core.Term @@ -209,3 +214,19 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorPackaging.missingDocumentationErrorName x))}]}) + +-- | Encoder for hydra.error.packaging.UndeclaredDependencyError +undeclaredDependencyError :: ErrorPackaging.UndeclaredDependencyError -> Core.Term +undeclaredDependencyError x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.error.packaging.UndeclaredDependencyError"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "moduleName"), + Core.fieldTerm = (EncodePackaging.moduleName (ErrorPackaging.undeclaredDependencyErrorModuleName x))}, + Core.Field { + Core.fieldName = (Core.Name "referencedName"), + Core.fieldTerm = (EncodeCore.name (ErrorPackaging.undeclaredDependencyErrorReferencedName x))}, + Core.Field { + Core.fieldName = (Core.Name "owningModuleName"), + Core.fieldTerm = (EncodePackaging.moduleName (ErrorPackaging.undeclaredDependencyErrorOwningModuleName x))}]}) diff --git a/src/main/haskell/Hydra/Encode/Regex.hs b/src/main/haskell/Hydra/Encode/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/Regex.hs @@ -0,0 +1,165 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.regex + +module Hydra.Encode.Regex where + +import qualified Hydra.Core as Core +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Regex as Regex +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.regex.Alternation +alternation :: [Regex.RegexSequence] -> Core.Term +alternation xs = Core.TermList (Lists.map regexSequence xs) + +-- | Encoder for hydra.regex.Atom +atom :: Regex.Atom -> Core.Term +atom x = + case x of + Regex.AtomLiteral v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "literal"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v0)))}}) + Regex.AtomAny -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "any"), + Core.fieldTerm = Core.TermUnit}}) + Regex.AtomAnchorStart -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "anchorStart"), + Core.fieldTerm = Core.TermUnit}}) + Regex.AtomAnchorEnd -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "anchorEnd"), + Core.fieldTerm = Core.TermUnit}}) + Regex.AtomGroup v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "group"), + Core.fieldTerm = (alternation v0)}}) + Regex.AtomClass v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Atom"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "class"), + Core.fieldTerm = (characterClass v0)}}) + +-- | Encoder for hydra.regex.CharacterClass +characterClass :: Regex.CharacterClass -> Core.Term +characterClass x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterClass"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "negated"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBoolean x2)) (Regex.characterClassNegated x))}, + Core.Field { + Core.fieldName = (Core.Name "items"), + Core.fieldTerm = ((\xs -> Core.TermList (Lists.map classItem xs)) (Regex.characterClassItems x))}]}) + +-- | Encoder for hydra.regex.CharacterRange +characterRange :: Regex.CharacterRange -> Core.Term +characterRange x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.CharacterRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "from"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Regex.characterRangeFrom x))}, + Core.Field { + Core.fieldName = (Core.Name "to"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Regex.characterRangeTo x))}]}) + +-- | Encoder for hydra.regex.ClassItem +classItem :: Regex.ClassItem -> Core.Term +classItem x = + case x of + Regex.ClassItemCharacter v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.ClassItem"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "character"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v0)))}}) + Regex.ClassItemRange v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.ClassItem"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (characterRange v0)}}) + +-- | Encoder for hydra.regex.Quantified +quantified :: Regex.Quantified -> Core.Term +quantified x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.Quantified"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "atom"), + Core.fieldTerm = (atom (Regex.quantifiedAtom x))}, + Core.Field { + Core.fieldName = (Core.Name "quantifier"), + Core.fieldTerm = (quantifier (Regex.quantifiedQuantifier x))}]}) + +-- | Encoder for hydra.regex.Quantifier +quantifier :: Regex.Quantifier -> Core.Term +quantifier x = + case x of + Regex.QuantifierOne -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "one"), + Core.fieldTerm = Core.TermUnit}}) + Regex.QuantifierZeroOrOne -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "zeroOrOne"), + Core.fieldTerm = Core.TermUnit}}) + Regex.QuantifierZeroOrMore -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "zeroOrMore"), + Core.fieldTerm = Core.TermUnit}}) + Regex.QuantifierOneOrMore -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "oneOrMore"), + Core.fieldTerm = Core.TermUnit}}) + Regex.QuantifierExactly v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "exactly"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v0)))}}) + Regex.QuantifierAtLeast v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "atLeast"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v0)))}}) + Regex.QuantifierRange_ v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.regex.Quantifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (quantifierRange v0)}}) + +-- | Encoder for hydra.regex.QuantifierRange +quantifierRange :: Regex.QuantifierRange -> Core.Term +quantifierRange x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.regex.QuantifierRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "min"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Regex.quantifierRangeMin x))}, + Core.Field { + Core.fieldName = (Core.Name "max"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Regex.quantifierRangeMax x))}]}) + +-- | Encoder for hydra.regex.Regex +regex :: Regex.Alternation -> Core.Term +regex = alternation + +-- | Encoder for hydra.regex.RegexSequence +regexSequence :: [Regex.Quantified] -> Core.Term +regexSequence xs = Core.TermList (Lists.map quantified xs) diff --git a/src/main/haskell/Hydra/Encode/Typed.hs b/src/main/haskell/Hydra/Encode/Typed.hs --- a/src/main/haskell/Hydra/Encode/Typed.hs +++ b/src/main/haskell/Hydra/Encode/Typed.hs @@ -23,6 +23,13 @@ Core.fieldName = (Core.Name "term"), Core.fieldTerm = (typedTerm a (Typed.typedBindingTerm x))}]}) +-- | Encoder for hydra.typed.TypedName +typedName :: (a -> Core.Term) -> Typed.TypedName a -> Core.Term +typedName a x = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.typed.TypedName"), + Core.wrappedTermBody = (EncodeCore.name (Typed.unTypedName x))}) + -- | Encoder for hydra.typed.TypedTerm typedTerm :: (a -> Core.Term) -> Typed.TypedTerm a -> Core.Term typedTerm a x = diff --git a/src/main/haskell/Hydra/Encoding.hs b/src/main/haskell/Hydra/Encoding.hs --- a/src/main/haskell/Hydra/Encoding.hs +++ b/src/main/haskell/Hydra/Encoding.hs @@ -27,7 +27,6 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Names as Names import qualified Hydra.Packaging as Packaging @@ -35,6 +34,7 @@ import qualified Hydra.Paths as Paths import qualified Hydra.Predicates as Predicates 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.Scoping as Scoping @@ -57,7 +57,7 @@ Eithers.bind (DecodeCore.type_ graph (Core.bindingTerm b)) (\typ -> let rawBody = encodeTypeNamed (Core.bindingName b) typ description = - Strings.cat [ + Strings.concat [ "Encoder for ", (Core.unName (Core.bindingName b))] in (Right (Core.Binding { @@ -67,17 +67,10 @@ -- | Generate a binding name for an encoder function from a type name encodeBindingName :: Core.Name -> Core.Name -encodeBindingName n = - - let parts = Strings.splitOn "." (Core.unName n) - localPart = Formatting.decapitalize (Names.localNameOf n) - localResult = Core.Name localPart - in (Optionals.cases (Lists.maybeInit parts) localResult (\nsParts -> Optionals.cases (Lists.uncons nsParts) localResult (\nsUc -> - let tail = Pairs.second nsUc - in (Core.Name (Strings.intercalate "." (Lists.concat2 [ - "hydra", - "encode"] (Lists.concat2 tail [ - localPart]))))))) +encodeBindingName = + Names.derivedBindingName [ + "hydra", + "encode"] True -- | Generate an encoder for an Either type encodeEitherType :: Core.EitherType -> Core.Term @@ -313,7 +306,7 @@ -- | Transform a type module into an encoder module encodeModule :: t0 -> Graph.Graph -> Packaging.Module -> Either Errors.Error (Maybe Packaging.Module) encodeModule cx graph mod = - Eithers.bind (filterTypeBindings cx graph (Optionals.cat (Lists.map (\d -> case d of + Eithers.bind (filterTypeBindings cx graph (Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ -> let schemaTerm = Core.TermVariable (Core.Name "hydra.core.Type") dataTerm = @@ -331,7 +324,7 @@ _ -> Nothing) (Packaging.moduleDefinitions mod)))) (\typeBindings -> Logic.ifElse (Lists.null typeBindings) (Right Nothing) (Eithers.bind (Eithers.mapList (\b -> Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\x -> x) (encodeBinding cx graph b)) typeBindings) (\encodedBindings -> Right (Just (Packaging.Module { Packaging.moduleName = (encodeModuleName (Packaging.moduleName mod)), Packaging.moduleMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just (Strings.cat [ + Packaging.entityMetadataDescription = (Just (Strings.concat [ "Term encoders for ", (Packaging.unModuleName (Packaging.moduleName mod))])), Packaging.entityMetadataComments = [], @@ -339,7 +332,7 @@ Packaging.entityMetadataLifecycle = Nothing})), Packaging.moduleDependencies = (Lists.map (\ns -> Packaging.ModuleDependency { Packaging.moduleDependencyModule = ns, - Packaging.moduleDependencyPackage = Nothing}) (Lists.nub (Lists.concat2 (Lists.map encodeModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))) [ + Packaging.moduleDependencyPackage = Nothing}) (Lists.distinct (Lists.concat2 (Lists.map encodeModuleName (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))) [ Packaging.moduleName mod]))), Packaging.moduleDefinitions = (Lists.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { Packaging.termDefinitionName = (Core.bindingName b), @@ -349,13 +342,10 @@ -- | Generate an encoder module name from a source module name encodeModuleName :: Packaging.ModuleName -> Packaging.ModuleName -encodeModuleName ns = - - let parts = Strings.splitOn "." (Packaging.unModuleName ns) - fallback = Packaging.ModuleName (Packaging.unModuleName ns) - in (Optionals.cases (Lists.uncons parts) fallback (\uc -> Packaging.ModuleName (Strings.cat [ - "hydra.encode.", - (Strings.intercalate "." (Pairs.second uc))]))) +encodeModuleName = + Names.derivedModuleName [ + "hydra", + "encode"] True -- | Encode a Name as a term encodeName :: Core.Name -> Core.Term @@ -752,7 +742,7 @@ let typeVars = encoderCollectForallVariables typ encoderFunType = encoderType typ allOrdVars = encoderCollectOrdVars typ - ordVars = Lists.filter (\v -> Lists.elem v typeVars) allOrdVars + ordVars = Lists.filter (\v -> Lists.member v typeVars) allOrdVars constraints = Logic.ifElse (Lists.null ordVars) Nothing (Just (Maps.fromList (Lists.map (\v -> ( v, @@ -771,7 +761,7 @@ let typeVars = encoderCollectForallVariables typ encoderFunType = encoderTypeNamed ename typ allOrdVars = encoderCollectOrdVars typ - ordVars = Lists.filter (\v -> Lists.elem v typeVars) allOrdVars + ordVars = Lists.filter (\v -> Lists.member v typeVars) allOrdVars constraints = Logic.ifElse (Lists.null ordVars) Nothing (Just (Maps.fromList (Lists.map (\v -> ( v, @@ -786,7 +776,7 @@ -- | Filter bindings to only encodable type definitions filterTypeBindings :: t0 -> Graph.Graph -> [Core.Binding] -> Either Errors.Error [Core.Binding] filterTypeBindings cx graph bindings = - Eithers.map Optionals.cat (Eithers.mapList (isEncodableBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) + Eithers.map Optionals.givens (Eithers.mapList (isEncodableBinding cx graph) (Lists.filter Annotations.isNativeType bindings)) -- | Check if a binding is encodable (serializable type) isEncodableBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error (Maybe Core.Binding) diff --git a/src/main/haskell/Hydra/Environment.hs b/src/main/haskell/Hydra/Environment.hs --- a/src/main/haskell/Hydra/Environment.hs +++ b/src/main/haskell/Hydra/Environment.hs @@ -32,6 +32,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping import qualified Hydra.Sorting as Sorting @@ -92,7 +93,7 @@ Packaging.DefinitionType _ -> Nothing Packaging.DefinitionTerm v0 -> Just v0 Packaging.DefinitionPrimitive _ -> Nothing - in (Optionals.cat (Lists.map getType defs), (Optionals.cat (Lists.map getTerm defs))) + in (Optionals.givens (Lists.map getType defs), (Optionals.givens (Lists.map getTerm defs))) -- | Reorder definitions: types first (with hydra.core.Name first among types), then topologically sorted terms reorderDefs :: [Packaging.Definition] -> [Packaging.Definition] @@ -145,7 +146,7 @@ Core.typeSchemeVariables = [], Core.typeSchemeBody = (Core.TypeVariable (Core.Name "hydra.core.Type")), Core.typeSchemeConstraints = Nothing})) (Eithers.map (\decoded -> Just (toTypeScheme [] decoded)) (decodeType (Core.bindingTerm el))) (forTerm (Strip.deannotateTerm (Core.bindingTerm el)))))) (\mts -> Right (Optionals.map (\ts -> (Core.bindingName el, ts)) mts))) - in (Eithers.map (\mpairs -> Maps.fromList (Optionals.cat mpairs)) (Eithers.mapList toPair (Lexical.graphToBindings g))) + in (Eithers.map (\mpairs -> Maps.fromList (Optionals.givens mpairs)) (Eithers.mapList toPair (Lexical.graphToBindings g))) -- | Extract the bindings from a let term, or return an empty list for other terms termAsBindings :: Core.Term -> [Core.Binding] diff --git a/src/main/haskell/Hydra/Error/Core.hs b/src/main/haskell/Hydra/Error/Core.hs --- a/src/main/haskell/Hydra/Error/Core.hs +++ b/src/main/haskell/Hydra/Error/Core.hs @@ -243,6 +243,8 @@ InvalidTermErrorInvalidLetBindingName InvalidLetBindingNameError | -- | A type lambda parameter name violating naming conventions (optional) InvalidTermErrorInvalidTypeLambdaParameterName InvalidTypeLambdaParameterNameError | + -- | A case statement that does not cover every variant of the union it matches + InvalidTermErrorMissingCaseBranches MissingCaseBranchesError | -- | Nested term annotations that should be merged (optional) InvalidTermErrorNestedTermAnnotation NestedTermAnnotationError | -- | A no-op unwrap-of-wrap round-trip (optional) @@ -261,6 +263,8 @@ InvalidTermErrorUndefinedTypeVariableInLambdaDomain UndefinedTypeVariableInLambdaDomainError | -- | An unbound type variable in a type application term InvalidTermErrorUndefinedTypeVariableInTypeApplication UndefinedTypeVariableInTypeApplicationError | + -- | A case statement alternative naming a field that does not exist in the union it matches + InvalidTermErrorUnknownCaseAlternative UnknownCaseAlternativeError | -- | A reference to an unknown primitive function InvalidTermErrorUnknownPrimitiveName UnknownPrimitiveNameError | -- | An identity lambda applied to an argument (optional) @@ -291,6 +295,8 @@ _InvalidTermError_invalidTypeLambdaParameterName = Core.Name "invalidTypeLambdaParameterName" +_InvalidTermError_missingCaseBranches = Core.Name "missingCaseBranches" + _InvalidTermError_nestedTermAnnotation = Core.Name "nestedTermAnnotation" _InvalidTermError_redundantWrapUnwrap = Core.Name "redundantWrapUnwrap" @@ -309,6 +315,8 @@ _InvalidTermError_undefinedTypeVariableInTypeApplication = Core.Name "undefinedTypeVariableInTypeApplication" +_InvalidTermError_unknownCaseAlternative = Core.Name "unknownCaseAlternative" + _InvalidTermError_unknownPrimitiveName = Core.Name "unknownPrimitiveName" _InvalidTermError_unnecessaryIdentityApplication = Core.Name "unnecessaryIdentityApplication" @@ -422,6 +430,25 @@ _LiteralTypeMismatchError_actualType = Core.Name "actualType" +-- | A case statement without a default branch that fails to cover every variant of the union it matches +data MissingCaseBranchesError = + MissingCaseBranchesError { + -- | The path to the case statement within the term + missingCaseBranchesErrorLocation :: Paths.SubtermPath, + -- | The name of the union type being matched + missingCaseBranchesErrorTypeName :: Core.Name, + -- | The names of the uncovered variants + missingCaseBranchesErrorVariantNames :: [Core.Name]} + deriving (Eq, Ord, Read, Show) + +_MissingCaseBranchesError = Core.Name "hydra.error.core.MissingCaseBranchesError" + +_MissingCaseBranchesError_location = Core.Name "location" + +_MissingCaseBranchesError_typeName = Core.Name "typeName" + +_MissingCaseBranchesError_variantNames = Core.Name "variantNames" + -- | A term annotation directly wrapping another term annotation; annotations should be merged (optional) data NestedTermAnnotationError = NestedTermAnnotationError { @@ -683,6 +710,25 @@ _UnexpectedTypeVariantError_expectedVariant = Core.Name "expectedVariant" _UnexpectedTypeVariantError_actualType = Core.Name "actualType" + +-- | A case statement alternative naming a field that does not exist in the union it matches +data UnknownCaseAlternativeError = + UnknownCaseAlternativeError { + -- | The path to the case statement within the term + unknownCaseAlternativeErrorLocation :: Paths.SubtermPath, + -- | The name of the union type being matched + unknownCaseAlternativeErrorTypeName :: Core.Name, + -- | The unknown alternative name + unknownCaseAlternativeErrorName :: Core.Name} + deriving (Eq, Ord, Read, Show) + +_UnknownCaseAlternativeError = Core.Name "hydra.error.core.UnknownCaseAlternativeError" + +_UnknownCaseAlternativeError_location = Core.Name "location" + +_UnknownCaseAlternativeError_typeName = Core.Name "typeName" + +_UnknownCaseAlternativeError_name = Core.Name "name" -- | A primitive function reference to a name not in the known primitive registry data UnknownPrimitiveNameError = diff --git a/src/main/haskell/Hydra/Error/Packaging.hs b/src/main/haskell/Hydra/Error/Packaging.hs --- a/src/main/haskell/Hydra/Error/Packaging.hs +++ b/src/main/haskell/Hydra/Error/Packaging.hs @@ -181,7 +181,9 @@ -- | A module within the package is invalid InvalidPackageErrorInvalidModule InvalidModuleError | -- | A package whose name does not match the package-name naming convention - InvalidPackageErrorInvalidPackageName InvalidPackageNameError + InvalidPackageErrorInvalidPackageName InvalidPackageNameError | + -- | A module references a name owned by another module that is not among its declared dependencies + InvalidPackageErrorUndeclaredDependency UndeclaredDependencyError deriving (Eq, Ord, Read, Show) _InvalidPackageError = Core.Name "hydra.error.packaging.InvalidPackageError" @@ -194,6 +196,8 @@ _InvalidPackageError_invalidPackageName = Core.Name "invalidPackageName" +_InvalidPackageError_undeclaredDependency = Core.Name "undeclaredDependency" + -- | A package whose name does not match the hyphen-separated lowercase naming convention. Package names must be hyphen-separated lowercase segments, each starting with a letter, e.g. hydra-kernel or hydra-python. data InvalidPackageNameError = InvalidPackageNameError { @@ -219,3 +223,22 @@ _MissingDocumentationError_moduleName = Core.Name "moduleName" _MissingDocumentationError_name = Core.Name "name" + +-- | A module references a name owned by another module which is not among its declared moduleDependencies. Like a missing import: the reference may still resolve today via another module's transitive dependencies, but the declared dependency list no longer reflects what the module actually uses, and inference-time resolution is not guaranteed. +data UndeclaredDependencyError = + UndeclaredDependencyError { + -- | The name of the module containing the undeclared reference + undeclaredDependencyErrorModuleName :: Packaging.ModuleName, + -- | The free name referenced by the module's definitions + undeclaredDependencyErrorReferencedName :: Core.Name, + -- | The name of the module that actually defines the referenced name + undeclaredDependencyErrorOwningModuleName :: Packaging.ModuleName} + deriving (Eq, Ord, Read, Show) + +_UndeclaredDependencyError = Core.Name "hydra.error.packaging.UndeclaredDependencyError" + +_UndeclaredDependencyError_moduleName = Core.Name "moduleName" + +_UndeclaredDependencyError_referencedName = Core.Name "referencedName" + +_UndeclaredDependencyError_owningModuleName = Core.Name "owningModuleName" diff --git a/src/main/haskell/Hydra/Extract/Core.hs b/src/main/haskell/Hydra/Extract/Core.hs --- a/src/main/haskell/Hydra/Extract/Core.hs +++ b/src/main/haskell/Hydra/Extract/Core.hs @@ -31,10 +31,11 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -64,7 +65,7 @@ Core.IntegerValueBigint v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "bigint", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract a binary data value from a term binary :: Graph.Graph -> Core.Term -> Either Errors.Error B.ByteString @@ -77,7 +78,7 @@ Core.LiteralBinary v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "binary", - Errors.unexpectedShapeErrorActual = (ShowCore.literal v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal v)}))) -- | Extract a boolean value from a term boolean :: Graph.Graph -> Core.Term -> Either Errors.Error Bool @@ -90,30 +91,18 @@ Core.LiteralBoolean v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "boolean", - Errors.unexpectedShapeErrorActual = (ShowCore.literal v)}))) - --- | Extract a specific case handler from a case statement term -caseField :: Core.Name -> String -> Graph.Graph -> Core.Term -> Either Errors.Error Core.CaseAlternative -caseField name n graph term = - - let fieldName = Core.Name n - in (Eithers.bind (cases name graph term) (\cs -> - let matching = - Lists.find (\f -> Equality.equal (Core.unName (Core.caseAlternativeName f)) (Core.unName fieldName)) (Core.caseStatementCases cs) - in (Optionals.cases matching (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = "matching case", - Errors.unexpectedShapeErrorActual = "no matching case"})))) (\mf -> Right mf)))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal v)}))) -- | Extract case statement from a term cases :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error Core.CaseStatement cases name graph term0 = Eithers.bind (Lexical.stripAndDereferenceTerm graph term0) (\term -> case term of Core.TermCases v0 -> Logic.ifElse (Equality.equal (Core.unName (Core.caseStatementTypeName v0)) (Core.unName name)) (Right v0) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "case statement for type " (Core.unName name)), - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "case statement for type " (Core.unName name)), + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "case statement", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract an arbitrary-precision decimal value from a term decimal :: Graph.Graph -> Core.Term -> Either Errors.Error Sci.Scientific @@ -126,7 +115,7 @@ Core.LiteralDecimal v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "decimal", - Errors.unexpectedShapeErrorActual = (ShowCore.literal v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal v)}))) -- | Decode an Either value using the provided left and right decoders decodeEither :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> (Graph.Graph -> Core.Term -> Either Errors.DecodingError t1) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Either t0 t1) @@ -177,13 +166,6 @@ Core.TermUnit -> Right () _ -> Left (Errors.DecodingError "expected a unit value")) --- | Decode a wrapped value using the provided body decoder -decodeWrapped :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError t0 -decodeWrapped bodyDecoder g term = - Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of - Core.TermWrap v0 -> bodyDecoder g (Core.wrappedTermBody v0) - _ -> Left (Errors.DecodingError "expected wrapped value")) - -- | Extract an either value from a term, applying functions to the left and right values eitherTerm :: (Core.Term -> Either Errors.Error t0) -> (Core.Term -> Either Errors.Error t1) -> Graph.Graph -> Core.Term -> Either Errors.Error (Either t0 t1) eitherTerm leftFun rightFun graph term0 = @@ -191,7 +173,7 @@ Core.TermEither v0 -> Eithers.either (\l -> Eithers.map (\x -> Left x) (leftFun l)) (\r -> Eithers.map (\x -> Right x) (rightFun r)) v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "either value", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract the left and right types from an either type eitherType :: Core.Type -> Either Errors.Error Core.EitherType @@ -202,7 +184,7 @@ Core.TypeEither v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "either type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a field value from a list of fields field :: Core.Name -> (Core.Term -> Either Errors.Error t0) -> Graph.Graph -> [Core.Field] -> Either Errors.Error t0 @@ -211,11 +193,11 @@ let matchingFields = Lists.filter (\f -> Equality.equal (Core.unName (Core.fieldName f)) (Core.unName fname)) fields noMatchErr = Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "field " (Core.unName fname)), + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "field " (Core.unName fname)), Errors.unexpectedShapeErrorActual = "no matching field"}))) - in (Logic.ifElse (Lists.null matchingFields) noMatchErr (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Optionals.cases (Lists.maybeHead matchingFields) noMatchErr (\mf -> Eithers.bind (Lexical.stripAndDereferenceTerm graph (Core.fieldTerm mf)) (\stripped -> mapping stripped))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { + in (Logic.ifElse (Lists.null matchingFields) noMatchErr (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Optionals.cases (Lists.head matchingFields) noMatchErr (\mf -> Eithers.bind (Lexical.stripAndDereferenceTerm graph (Core.fieldTerm mf)) (\stripped -> mapping stripped))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "single field", - Errors.unexpectedShapeErrorActual = (Strings.cat2 "multiple fields named " (Core.unName fname))})))))) + Errors.unexpectedShapeErrorActual = (Strings.concat2 "multiple fields named " (Core.unName fname))})))))) -- | Extract a 32-bit floating-point value from a term float32 :: Graph.Graph -> Core.Term -> Either Errors.Error Float @@ -228,7 +210,7 @@ Core.FloatValueFloat32 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "float32", - Errors.unexpectedShapeErrorActual = (ShowCore.float v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.float v)}))) -- | Extract a 64-bit floating-point value from a term float64 :: Graph.Graph -> Core.Term -> Either Errors.Error Double @@ -241,7 +223,7 @@ Core.FloatValueFloat64 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "float64", - Errors.unexpectedShapeErrorActual = (ShowCore.float v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.float v)}))) -- | Extract a floating-point literal from a Literal value floatLiteral :: Core.Literal -> Either Errors.Error Core.FloatValue @@ -250,7 +232,7 @@ Core.LiteralFloat v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "floating-point value", - Errors.unexpectedShapeErrorActual = (ShowCore.literal lit)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal lit)}))) -- | Extract a float value from a term floatValue :: Graph.Graph -> Core.Term -> Either Errors.Error Core.FloatValue @@ -265,18 +247,18 @@ Core.TypeFunction v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "function type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a field from a union term injection :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Field injection expected graph term0 = Eithers.bind (Lexical.stripAndDereferenceTerm graph term0) (\term -> case term of Core.TermInject v0 -> Logic.ifElse (Equality.equal (Core.unName (Core.injectionTypeName v0)) (Core.unName expected)) (Right (Core.injectionField v0)) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "injection of type " (Core.unName expected)), + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "injection of type " (Core.unName expected)), Errors.unexpectedShapeErrorActual = (Core.unName (Core.injectionTypeName v0))})))) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "injection", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract a 16-bit signed integer value from a term int16 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int16 @@ -289,7 +271,7 @@ Core.IntegerValueInt16 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int16", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract a 32-bit signed integer value from a term int32 :: Graph.Graph -> Core.Term -> Either Errors.Error Int @@ -302,7 +284,7 @@ Core.IntegerValueInt32 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int32", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract a 64-bit signed integer value from a term int64 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int64 @@ -315,7 +297,7 @@ Core.IntegerValueInt64 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int64", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract an 8-bit signed integer value from a term int8 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int8 @@ -328,7 +310,7 @@ Core.IntegerValueInt8 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int8", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract an integer literal from a Literal value integerLiteral :: Core.Literal -> Either Errors.Error Core.IntegerValue @@ -337,7 +319,7 @@ Core.LiteralInteger v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "integer value", - Errors.unexpectedShapeErrorActual = (ShowCore.literal lit)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal lit)}))) -- | Extract an integer value from a term integerValue :: Graph.Graph -> Core.Term -> Either Errors.Error Core.IntegerValue @@ -350,7 +332,7 @@ Core.TermLambda v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "lambda", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract the body of a lambda term lambdaBody :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Term @@ -363,7 +345,7 @@ Core.TermLet v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "let term", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract a binding with the given name from a let term letBinding :: String -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term @@ -376,7 +358,7 @@ noBindingErr = Left (Errors.ErrorExtraction (Errors.ExtractionErrorNoSuchBinding (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = name}))) - in (Logic.ifElse (Lists.null matchingBindings) noBindingErr (Logic.ifElse (Equality.equal (Lists.length matchingBindings) 1) (Optionals.cases (Lists.maybeHead matchingBindings) noBindingErr (\b -> Right (Core.bindingTerm b))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorMultipleBindings (Errors.MultipleBindingsError { + in (Logic.ifElse (Lists.null matchingBindings) noBindingErr (Logic.ifElse (Equality.equal (Lists.length matchingBindings) 1) (Optionals.cases (Lists.head matchingBindings) noBindingErr (\b -> Right (Core.bindingTerm b))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorMultipleBindings (Errors.MultipleBindingsError { Errors.multipleBindingsErrorName = name})))))))) -- | Extract a list of terms from a term @@ -386,14 +368,7 @@ Core.TermList v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "list", - Errors.unexpectedShapeErrorActual = (ShowCore.term stripped)})))) - --- | Extract the first element of a list term -listHead :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Term -listHead graph term = - Eithers.bind (list graph term) (\l -> Optionals.cases (Lists.maybeHead l) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = "non-empty list", - Errors.unexpectedShapeErrorActual = "empty list"})))) (\h -> Right h)) + Errors.unexpectedShapeErrorActual = (PrintCore.term stripped)})))) -- | Extract a list of values from a term, mapping a function over each element listOf :: (Core.Term -> Either Errors.Error t0) -> Graph.Graph -> Core.Term -> Either Errors.Error [t0] @@ -408,7 +383,7 @@ Core.TypeList v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "list type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a literal value from a term literal :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Literal @@ -417,7 +392,7 @@ Core.TermLiteral v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "literal", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract a map of key-value pairs from a term, mapping functions over each key and value map :: Ord t0 => ((Core.Term -> Either Errors.Error t0) -> (Core.Term -> Either Errors.Error t1) -> Graph.Graph -> Core.Term -> Either Errors.Error (M.Map t0 t1)) @@ -432,7 +407,7 @@ Core.TermMap v0 -> Eithers.map Maps.fromList (Eithers.mapList pair (Maps.toList v0)) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "map", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)}))))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)}))))) -- | Extract the key and value types from a map type mapType :: Core.Type -> Either Errors.Error Core.MapType @@ -443,16 +418,16 @@ Core.TypeMap v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "map type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Ensure a function has the expected number of arguments nArgs :: Core.Name -> Int -> [t0] -> Either Errors.Error () nArgs name n args = Logic.ifElse (Equality.equal (Lists.length args) n) (Right ()) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat [ + Errors.unexpectedShapeErrorExpected = (Strings.concat [ Literals.showInt32 n, " arguments to primitive ", - (Literals.showString (Core.unName name))]), + (Literals.printString (Core.unName name))]), Errors.unexpectedShapeErrorActual = (Literals.showInt32 (Lists.length args))})))) -- | Extract an optional value from a term, applying a function to the value if present @@ -462,7 +437,7 @@ Core.TermOptional v0 -> Optionals.cases v0 (Right Nothing) (\t -> Eithers.map Optionals.pure (f t)) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "optional value", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract the base type from an optional type optionalType :: Core.Type -> Either Errors.Error Core.Type @@ -473,7 +448,7 @@ Core.TypeOptional v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "optional type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a pair of values from a term, applying functions to each component pair :: (Core.Term -> Either Errors.Error t0) -> (Core.Term -> Either Errors.Error t1) -> Graph.Graph -> Core.Term -> Either Errors.Error (t0, t1) @@ -482,13 +457,13 @@ Core.TermPair v0 -> Eithers.bind (kf (Pairs.first v0)) (\kVal -> Eithers.bind (vf (Pairs.second v0)) (\vVal -> Right (kVal, vVal))) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "pair", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract a record's fields from a term record :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error [Core.Field] record expected graph term0 = Eithers.bind (termRecord graph term0) (\record -> Logic.ifElse (Equality.equal (Core.recordTypeName record) expected) (Right (Core.recordFields record)) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "record of type " (Core.unName expected)), + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "record of type " (Core.unName expected)), Errors.unexpectedShapeErrorActual = (Core.unName (Core.recordTypeName record))}))))) -- | Extract the field types from a record type @@ -500,12 +475,12 @@ Core.TypeRecord v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Require a field from a record's field map and decode it requireField :: String -> (t0 -> t1 -> Either Errors.DecodingError t2) -> M.Map Core.Name t1 -> t0 -> Either Errors.DecodingError t2 requireField fieldName decoder fieldMap g = - Optionals.cases (Maps.lookup (Core.Name fieldName) fieldMap) (Left (Errors.DecodingError (Strings.cat [ + Optionals.cases (Maps.lookup (Core.Name fieldName) fieldMap) (Left (Errors.DecodingError (Strings.concat [ "missing field ", fieldName, " in record"]))) (\fieldTerm -> decoder g fieldTerm) @@ -517,7 +492,7 @@ Core.TermSet v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "set", - Errors.unexpectedShapeErrorActual = (ShowCore.term stripped)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term stripped)})))) -- | Extract a set of values from a term, mapping a function over each element setOf :: Ord t0 => ((Core.Term -> Either Errors.Error t0) -> Graph.Graph -> Core.Term -> Either Errors.Error (S.Set t0)) @@ -532,7 +507,7 @@ Core.TypeSet v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "set type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a string value from a term string :: Graph.Graph -> Core.Term -> Either Errors.Error String @@ -545,12 +520,12 @@ Core.LiteralString v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "string", - Errors.unexpectedShapeErrorActual = (ShowCore.literal v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.literal v)}))) -- | Strip annotations and dereference variables, returning Either DecodingError Term stripWithDecodingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Term stripWithDecodingError g term = - Eithers.bimap (\_e -> Errors.DecodingError (ShowErrors.error _e)) (\x -> x) (Lexical.stripAndDereferenceTermEither g term) + Eithers.bimap (\_e -> Errors.DecodingError (PrintErrors.error _e)) (\x -> x) (Lexical.stripAndDereferenceTermEither g term) -- | Extract a record from a term termRecord :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Record @@ -559,7 +534,7 @@ Core.TermRecord v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Convert a Record's fields to a Map from Name to Term toFieldMap :: Core.Record -> M.Map Core.Name Core.Term @@ -576,7 +551,7 @@ Core.IntegerValueUint16 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint16", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract a 32-bit unsigned integer value from a term uint32 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int64 @@ -589,7 +564,7 @@ Core.IntegerValueUint32 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint32", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract a 64-bit unsigned integer value from a term uint64 :: Graph.Graph -> Core.Term -> Either Errors.Error Integer @@ -602,7 +577,7 @@ Core.IntegerValueUint64 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint64", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract an 8-bit unsigned integer value from a term uint8 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int16 @@ -615,7 +590,7 @@ Core.IntegerValueUint8 v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint8", - Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.integer v)}))) -- | Extract the field types from a union type unionType :: t0 -> Core.Type -> Either Errors.Error [Core.FieldType] @@ -626,7 +601,7 @@ Core.TypeUnion v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "union type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) -- | Extract a unit value from a term unit :: Core.Term -> Either Errors.Error () @@ -635,7 +610,7 @@ Core.TermUnit -> Right () _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "unit", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)}))) -- | Extract a unit variant (a variant with an empty record value) from a union term unitVariant :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Name @@ -647,11 +622,11 @@ wrap expected graph term0 = Eithers.bind (Lexical.stripAndDereferenceTerm graph term0) (\term -> case term of Core.TermWrap v0 -> Logic.ifElse (Equality.equal (Core.unName (Core.wrappedTermTypeName v0)) (Core.unName expected)) (Right (Core.wrappedTermBody v0)) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "wrapper of type " (Core.unName expected)), + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "wrapper of type " (Core.unName expected)), Errors.unexpectedShapeErrorActual = (Core.unName (Core.wrappedTermTypeName v0))})))) _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 (Strings.cat2 "wrap(" (Core.unName expected)) ")"), - Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + Errors.unexpectedShapeErrorExpected = (Strings.concat2 (Strings.concat2 "wrap(" (Core.unName expected)) ")"), + Errors.unexpectedShapeErrorActual = (PrintCore.term term)})))) -- | Extract the wrapped type from a wrapper type wrappedType :: t0 -> Core.Type -> Either Errors.Error Core.Type @@ -662,4 +637,4 @@ Core.TypeWrap v0 -> Right v0 _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "wrapped type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ typ)}))) diff --git a/src/main/haskell/Hydra/Extract/Json.hs b/src/main/haskell/Hydra/Extract/Json.hs --- a/src/main/haskell/Hydra/Extract/Json.hs +++ b/src/main/haskell/Hydra/Extract/Json.hs @@ -17,6 +17,7 @@ import qualified Hydra.File as File import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as Model +import qualified Hydra.Json.Writer as Writer import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals @@ -25,6 +26,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -45,28 +47,28 @@ expectArray value = case value of Model.ValueArray v0 -> Right v0 - _ -> Left (Strings.cat2 (Strings.cat2 "expected " "JSON array") (Strings.cat2 " but found " (showValue value))) + _ -> Left (Strings.concat2 (Strings.concat2 "expected " "JSON array") (Strings.concat2 " but found " (showValue value))) -- | Extract a number from a JSON value, failing if the value is not a number expectNumber :: Model.Value -> Either String Sci.Scientific expectNumber value = case value of Model.ValueNumber v0 -> Right v0 - _ -> Left (Strings.cat2 (Strings.cat2 "expected " "JSON number") (Strings.cat2 " but found " (showValue value))) + _ -> Left (Strings.concat2 (Strings.concat2 "expected " "JSON number") (Strings.concat2 " but found " (showValue value))) -- | Extract an object from a JSON value as a name-keyed map, failing if the value is not an object. Field order is not preserved; lookups are by name. expectObject :: Model.Value -> Either String (M.Map String Model.Value) expectObject value = case value of Model.ValueObject v0 -> Right (Maps.fromList v0) - _ -> Left (Strings.cat2 (Strings.cat2 "expected " "JSON object") (Strings.cat2 " but found " (showValue value))) + _ -> Left (Strings.concat2 (Strings.concat2 "expected " "JSON object") (Strings.concat2 " but found " (showValue value))) -- | Extract a string from a JSON value, failing if the value is not a string expectString :: Model.Value -> Either String String expectString value = case value of Model.ValueString v0 -> Right v0 - _ -> Left (Strings.cat2 (Strings.cat2 "expected " "JSON string") (Strings.cat2 " but found " (showValue value))) + _ -> Left (Strings.concat2 (Strings.concat2 "expected " "JSON string") (Strings.concat2 " but found " (showValue value))) -- | Look up an optional field in a JSON object opt :: Ord t0 => (t0 -> M.Map t0 t1 -> Maybe t1) @@ -81,25 +83,25 @@ optString fname m = Optionals.cases (opt fname m) (Right Nothing) (\s -> Eithers.map (\x -> Just x) (expectString s)) -- | Look up a required field in a JSON object, failing if not found -require :: Ord t0 => (t0 -> M.Map t0 t1 -> Either String t1) +require :: String -> M.Map String t0 -> Either String t0 require fname m = - Optionals.cases (Maps.lookup fname m) (Left (Strings.cat [ + Optionals.cases (Maps.lookup fname m) (Left (Strings.concat [ "required attribute ", - (showValue fname), + (showValue (Model.ValueString fname)), " not found"])) (\value -> Right value) -- | Look up a required array field in a JSON object -requireArray :: Ord t0 => (t0 -> M.Map t0 Model.Value -> Either String [Model.Value]) +requireArray :: String -> M.Map String Model.Value -> Either String [Model.Value] requireArray fname m = Eithers.bind (require fname m) expectArray -- | Look up a required number field in a JSON object -requireNumber :: Ord t0 => (t0 -> M.Map t0 Model.Value -> Either String Sci.Scientific) +requireNumber :: String -> M.Map String Model.Value -> Either String Sci.Scientific requireNumber fname m = Eithers.bind (require fname m) expectNumber -- | Look up a required string field in a JSON object -requireString :: Ord t0 => (t0 -> M.Map t0 Model.Value -> Either String String) +requireString :: String -> M.Map String Model.Value -> Either String String requireString fname m = Eithers.bind (require fname m) expectString --- | Show a JSON value as a string (placeholder implementation) -showValue :: t0 -> String -showValue value = "TODO: implement showValue" +-- | Show a JSON value as a string +showValue :: Model.Value -> String +showValue value = Writer.printJson value diff --git a/src/main/haskell/Hydra/Extract/Util.hs b/src/main/haskell/Hydra/Extract/Util.hs --- a/src/main/haskell/Hydra/Extract/Util.hs +++ b/src/main/haskell/Hydra/Extract/Util.hs @@ -24,9 +24,10 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing diff --git a/src/main/haskell/Hydra/Formatting.hs b/src/main/haskell/Hydra/Formatting.hs --- a/src/main/haskell/Hydra/Formatting.hs +++ b/src/main/haskell/Hydra/Formatting.hs @@ -24,6 +24,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -31,6 +32,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -60,7 +62,7 @@ let splitOnUppercase = \acc -> \c -> Lists.concat2 (Logic.ifElse (Chars.isUpper c) [ - []] []) (Optionals.fromOptional acc (Optionals.map (\uc -> Lists.cons (Lists.cons c (Pairs.first uc)) (Pairs.second uc)) (Lists.uncons acc))) + []] []) (Optionals.withDefault acc (Optionals.map (\uc -> Lists.cons (Lists.cons c (Pairs.first uc)) (Pairs.second uc)) (Lists.uncons acc))) in (Lists.map Strings.fromList (Lists.foldl splitOnUppercase [ []] (Lists.reverse (Strings.toList (decapitalize original))))) byUnderscores = Strings.splitOn "_" original @@ -70,10 +72,10 @@ Util.CaseConventionLowerSnake -> byUnderscores Util.CaseConventionUpperSnake -> byUnderscores in case to of - Util.CaseConventionCamel -> decapitalize (Strings.cat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts)) - Util.CaseConventionPascal -> Strings.cat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts) - Util.CaseConventionLowerSnake -> Strings.intercalate "_" (Lists.map Strings.toLower parts) - Util.CaseConventionUpperSnake -> Strings.intercalate "_" (Lists.map Strings.toUpper parts) + Util.CaseConventionCamel -> decapitalize (Strings.concat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts)) + Util.CaseConventionPascal -> Strings.concat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts) + Util.CaseConventionLowerSnake -> Strings.join "_" (Lists.map Strings.toLower parts) + Util.CaseConventionUpperSnake -> Strings.join "_" (Lists.map Strings.toUpper parts) -- | Convert a string from camel case (possibly with underscores) to lower snake case. Splits on underscores first, then converts each part from camel case. convertCaseCamelOrUnderscoreToLowerSnake :: String -> String @@ -81,7 +83,7 @@ let parts = Strings.splitOn "_" s snakeParts = Lists.map (\p -> convertCaseCamelToLowerSnake p) parts - in (Strings.intercalate "_" snakeParts) + in (Strings.join "_" snakeParts) -- | Convert a string from camel case to lower snake case convertCaseCamelToLowerSnake :: String -> String @@ -101,34 +103,34 @@ -- | Escape reserved words by appending an underscore escapeWithUnderscore :: S.Set String -> String -> String -escapeWithUnderscore reserved s = Logic.ifElse (Sets.member s reserved) (Strings.cat2 s "_") s +escapeWithUnderscore reserved s = Logic.ifElse (Sets.member s reserved) (Strings.concat2 s "_") s -- | Indent each line of a string with four spaces indentLines :: String -> String indentLines s = - let indent = \l -> Strings.cat2 " " l + let indent = \l -> Strings.concat2 " " l in (Strings.unlines (Lists.map indent (Strings.lines s))) -- | Format a string as a Java-style block comment javaStyleComment :: String -> String -javaStyleComment s = Strings.cat2 (Strings.cat2 (Strings.cat2 "/**\n" " * ") s) "\n */" +javaStyleComment s = Strings.concat2 (Strings.concat2 (Strings.concat2 "/**\n" " * ") s) "\n */" -- | A helper which maps the first letter of a string to another string mapFirstLetter :: (String -> String) -> String -> String mapFirstLetter mapping s = Logic.ifElse (Strings.null s) s ( let list = Strings.toList s - in (Optionals.fromOptional s (Optionals.map (\uc -> + in (Optionals.withDefault s (Optionals.map (\uc -> let firstLetter = mapping (Strings.fromList (Lists.pure (Pairs.first uc))) - in (Strings.cat2 firstLetter (Strings.fromList (Pairs.second uc)))) (Lists.uncons list)))) + in (Strings.concat2 firstLetter (Strings.fromList (Pairs.second uc)))) (Lists.uncons list)))) -- | Replace sequences of non-alphanumeric characters with single underscores nonAlnumToUnderscores :: String -> String nonAlnumToUnderscores input = let isAlnum = - \c -> Logic.or (Logic.and (Equality.gte c 65) (Equality.lte c 90)) (Logic.or (Logic.and (Equality.gte c 97) (Equality.lte c 122)) (Logic.and (Equality.gte c 48) (Equality.lte c 57))) + \c -> Logic.or (Logic.and (Ordering.gte c 65) (Ordering.lte c 90)) (Logic.or (Logic.and (Ordering.gte c 97) (Ordering.lte c 122)) (Logic.and (Ordering.gte c 48) (Ordering.lte c 57))) replace = \p -> \c -> let s = Pairs.first p @@ -144,8 +146,8 @@ let stripped = stripLeadingAndTrailingWhitespace s in (Logic.ifElse (Strings.null stripped) "" ( let lastIdx = Math.sub (Strings.length stripped) 1 - appended = Strings.cat2 stripped "." - in (Optionals.cases (Strings.maybeCharAt lastIdx stripped) appended (\lastChar -> Logic.ifElse (Equality.equal lastChar 46) stripped appended)))) + appended = Strings.concat2 stripped "." + in (Optionals.cases (Strings.charAt lastIdx stripped) appended (\lastChar -> Logic.ifElse (Equality.equal lastChar 46) stripped appended)))) -- | Sanitize a string by replacing non-alphanumeric characters and escaping reserved words sanitizeWithUnderscores :: S.Set String -> String -> String @@ -154,9 +156,9 @@ -- | Format a list of elements as a bracketed, comma-separated string showList :: (t0 -> String) -> [t0] -> String showList f els = - Strings.cat [ + Strings.concat [ "[", - (Strings.intercalate ", " (Lists.map f els)), + (Strings.join ", " (Lists.map f els)), "]"] -- | Remove leading and trailing whitespace from a string @@ -203,7 +205,7 @@ (124, "verbar"), (125, "rcub"), (126, "tilde")] - alias = \c -> Optionals.fromOptional (Lists.pure c) (Optionals.map Strings.toList (Maps.lookup c aliases)) + alias = \c -> Optionals.withDefault (Lists.pure c) (Optionals.map Strings.toList (Maps.lookup c aliases)) in (Strings.fromList (Lists.filter Chars.isAlphaNum (Lists.concat (Lists.map alias (Strings.toList original))))) -- | A simple soft line wrap which is suitable for code comments @@ -217,6 +219,6 @@ Lists.span (\c -> Logic.and (Logic.not (Equality.equal c 32)) (Logic.not (Equality.equal c 9))) (Lists.reverse trunc) prefix = Lists.reverse (Pairs.second spanResult) suffix = Lists.reverse (Pairs.first spanResult) - in (Logic.ifElse (Equality.lte (Lists.length rem) maxlen) (Lists.reverse (Lists.cons rem prev)) (Logic.ifElse (Lists.null prefix) (helper (Lists.cons trunc prev) (Lists.drop maxlen rem)) (Optionals.fromOptional (helper (Lists.cons trunc prev) (Lists.drop maxlen rem)) (Optionals.map (\pfxInit -> helper (Lists.cons pfxInit prev) (Lists.concat2 suffix (Lists.drop maxlen rem))) (Lists.maybeInit prefix))))) - in (Strings.fromList (Lists.intercalate [ + in (Logic.ifElse (Ordering.lte (Lists.length rem) maxlen) (Lists.reverse (Lists.cons rem prev)) (Logic.ifElse (Lists.null prefix) (helper (Lists.cons trunc prev) (Lists.drop maxlen rem)) (Optionals.withDefault (helper (Lists.cons trunc prev) (Lists.drop maxlen rem)) (Optionals.map (\pfxInit -> helper (Lists.cons pfxInit prev) (Lists.concat2 suffix (Lists.drop maxlen rem))) (Lists.init prefix))))) + in (Strings.fromList (Lists.join [ 10] (helper [] (Strings.toList input)))) diff --git a/src/main/haskell/Hydra/Hoisting.hs b/src/main/haskell/Hydra/Hoisting.hs --- a/src/main/haskell/Hydra/Hoisting.hs +++ b/src/main/haskell/Hydra/Hoisting.hs @@ -26,6 +26,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -33,6 +34,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Resolution as Resolution import qualified Hydra.Rewriting as Rewriting @@ -73,7 +75,7 @@ \b -> let freeVars = Sets.toList (Sets.intersection boundVars (Variables.freeVariablesInTerm (Core.bindingTerm b))) varTypePairs = Lists.map (\v -> (v, (Maps.lookup v types))) freeVars - varTypes = Optionals.cat (Lists.map Pairs.second varTypePairs) + varTypes = Optionals.givens (Lists.map Pairs.second varTypePairs) in (Logic.ifElse (Logic.or (Lists.null freeVars) (Logic.not (Equality.equal (Lists.length varTypes) (Lists.length varTypePairs)))) (b, Nothing) ( Core.Binding { Core.bindingName = (Core.bindingName b), @@ -90,7 +92,7 @@ Core.applicationFunction = t, Core.applicationArgument = (Core.TermVariable v)})) (Core.TermVariable (Core.bindingName b)) freeVars))))) results = Lists.map augment bindings - in (Lists.map Pairs.first results, (Typing.TermSubst (Maps.fromList (Optionals.cat (Lists.map Pairs.second results))))) + in (Lists.map Pairs.first results, (Typing.TermSubst (Maps.fromList (Optionals.givens (Lists.map Pairs.second results))))) -- | Check if a binding has a polymorphic type (non-empty list of type scheme variables) bindingIsPolymorphic :: Core.Binding -> Bool @@ -173,18 +175,18 @@ types = Maps.map Scoping.typeSchemeToFType (Graph.graphBoundTypes cx) capturedTermVarTypePairs = Lists.map (\v -> (v, (Maps.lookup v types))) capturedTermVars capturedTermVarTypes = - Lists.map (\typ -> Strip.deannotateTypeParameters typ) (Optionals.cat (Lists.map Pairs.second capturedTermVarTypePairs)) + Lists.map (\typ -> Strip.deannotateTypeParameters typ) (Optionals.givens (Lists.map Pairs.second capturedTermVarTypePairs)) freeInBindingType = Optionals.cases (Core.bindingTypeScheme b) Sets.empty (\ts -> Variables.freeVariablesInType (Core.typeSchemeBody ts)) freeInCapturedVarTypes = Sets.unions (Lists.map (\t -> Variables.freeVariablesInType t) capturedTermVarTypes) capturedTypeVars = Sets.toList (Sets.intersection (Graph.graphTypeVariables cx) (Sets.union freeInBindingType freeInCapturedVarTypes)) globalBindingName = - Lexical.chooseUniqueName alreadyUsedNames (Core.Name (Strings.cat2 prefix (Core.unName (Core.bindingName b)))) + Lexical.chooseUniqueName alreadyUsedNames (Core.Name (Strings.concat2 prefix (Core.unName (Core.bindingName b)))) newUsedNames = Sets.insert globalBindingName alreadyUsedNames newTypeScheme = Logic.ifElse (Equality.equal (Lists.length capturedTermVarTypes) (Lists.length capturedTermVarTypePairs)) (Optionals.map (\ts -> Core.TypeScheme { - Core.typeSchemeVariables = (Lists.nub (Lists.concat2 capturedTypeVars (Core.typeSchemeVariables ts))), + Core.typeSchemeVariables = (Lists.distinct (Lists.concat2 capturedTypeVars (Core.typeSchemeVariables ts))), Core.typeSchemeBody = (Lists.foldl (\t -> \a -> Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = a, Core.functionTypeCodomain = t})) (Core.typeSchemeBody ts) (Lists.reverse capturedTermVarTypes)), @@ -256,7 +258,7 @@ hoistBindingMap = Maps.fromList (Lists.map (\b -> (Core.bindingName b, b)) hoistUs) isCacheable = \name -> - let multiRef = Equality.gte (countVarOccurrences name body) 2 + let multiRef = Ordering.gte (countVarOccurrences name body) 2 isPoly = Optionals.cases (Maps.lookup name hoistBindingMap) False (\b -> bindingIsPolymorphic b) in (Logic.and multiRef (Logic.not isPoly)) singleRefPairs = Lists.filter (\p -> Logic.not (isCacheable (Pairs.first p))) hoistNameReplacementPairs @@ -301,7 +303,7 @@ cx1 = Scoping.extendGraphForLet (\c -> \b -> Nothing) cx0 let0 forActiveBinding = \b -> - let prefix = Strings.cat2 (Core.unName (Core.bindingName b)) "_" + let prefix = Strings.concat2 (Core.unName (Core.bindingName b)) "_" init = ([], (Sets.singleton (Core.bindingName b))) resultPair = Rewriting.rewriteAndFoldTermWithGraph (rewrite prefix) cx1 init (Core.bindingTerm b) resultBindings = Pairs.first (Pairs.first resultPair) @@ -355,7 +357,7 @@ fullPath = Lists.concat2 pathPrefix path in (Logic.ifElse (shouldHoist (fullPath, processedTerm)) ( let proposedName = - Core.Name (Strings.cat [ + Core.Name (Strings.concat [ "_hoist_", namePrefix, "_", @@ -401,7 +403,7 @@ body = Core.letBody lt processBinding = \acc -> \binding -> - let namePrefix = Strings.intercalate "_" (Strings.splitOn "." (Core.unName (Core.bindingName binding))) + let namePrefix = Strings.join "_" (Strings.splitOn "." (Core.unName (Core.bindingName binding))) bindingPathPrefix = Lists.concat2 path [ Paths.SubtermStepLetBinding (Core.bindingName binding)] result = processImmediateSubterm cx 1 namePrefix bindingPathPrefix (Core.bindingTerm binding) @@ -417,8 +419,8 @@ bodyPathPrefix = Lists.concat2 path [ Paths.SubtermStepLetBody] firstBindingName = - Optionals.cases (Lists.maybeHead bindings) "body" (\b -> Strings.intercalate "_" (Strings.splitOn "." (Core.unName (Core.bindingName b)))) - bodyPrefix = Strings.cat2 firstBindingName "_body" + Optionals.cases (Lists.head bindings) "body" (\b -> Strings.join "_" (Strings.splitOn "." (Core.unName (Core.bindingName b)))) + bodyPrefix = Strings.concat2 firstBindingName "_body" bodyResult = processImmediateSubterm cx 1 bodyPrefix bodyPathPrefix body newBody = Pairs.second bodyResult in ( diff --git a/src/main/haskell/Hydra/Inference.hs b/src/main/haskell/Hydra/Inference.hs --- a/src/main/haskell/Hydra/Inference.hs +++ b/src/main/haskell/Hydra/Inference.hs @@ -29,6 +29,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -36,15 +37,16 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors +import qualified Hydra.Print.Typing as PrintTyping import qualified Hydra.Query as Query import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Resolution as Resolution import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors -import qualified Hydra.Show.Typing as ShowTyping import qualified Hydra.Sorting as Sorting import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System @@ -67,7 +69,7 @@ -- | Return the element at the given index, or Left(Other) with the given description if out of range atOrFail :: Int -> String -> [t0] -> Either Errors.Error t0 atOrFail i desc xs = - Optionals.cases (Lists.maybeAt i xs) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "atOrFail: " desc)))) (\x -> Right x) + Optionals.cases (Lists.at i xs) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "atOrFail: " desc)))) (\x -> Right x) -- | Unify type constraints and check the substitution bindConstraints :: Typing.InferenceContext -> Graph.Graph -> [Typing.TypeConstraint] -> Either Errors.Error Typing.TypeSubst @@ -164,19 +166,19 @@ cx2 = Pairs.second result in (Core.TypeVariable name, cx2) --- | Generalize a type to a type scheme +-- | Generalize a type to a type scheme. Paper: inference.tex, gen() and rule Gen. generalize :: Graph.Graph -> Core.Type -> Core.TypeScheme generalize cx typ = let isTypeVarName = \name -> let parts = Strings.splitOn "." (Core.unName name) - in (Equality.lte (Lists.length parts) 1) + in (Ordering.lte (Lists.length parts) 1) vars = - Lists.nub (Lists.filter (\v -> Logic.and (isUnbound cx v) (isTypeVarName v)) (Variables.freeVariablesInTypeOrdered typ)) + Lists.distinct (Lists.filter (\v -> Logic.and (isUnbound cx v) (isTypeVarName v)) (Variables.freeVariablesInTypeOrdered typ)) allConstraints = Graph.graphClassConstraints cx relevantConstraints = - Maps.fromList (Optionals.cat (Lists.map (\v -> Optionals.map (\meta -> (v, meta)) (Maps.lookup v allConstraints)) vars)) + Maps.fromList (Optionals.givens (Lists.map (\v -> Optionals.map (\meta -> (v, meta)) (Maps.lookup v allConstraints)) vars)) constraintsMaybe = Logic.ifElse (Maps.null relevantConstraints) Nothing (Just relevantConstraints) in Core.TypeScheme { Core.typeSchemeVariables = vars, @@ -186,9 +188,9 @@ -- | Return the first element of a list, or Left(Other) with the given description if the list is empty headOrFail :: String -> [t0] -> Either Errors.Error t0 headOrFail desc xs = - Optionals.cases (Lists.maybeHead xs) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "headOrFail: " desc)))) (\x -> Right x) + Optionals.cases (Lists.head xs) (Left (Errors.ErrorOther (Errors.OtherError (Strings.concat2 "headOrFail: " desc)))) (\x -> Right x) --- | Infer types for all elements in a graph, using the provided ordered bindings. Returns both the inferred graph and the ordered inferred bindings. +-- | Infer types for all elements in a graph, using the provided ordered bindings. Returns both the inferred graph and the ordered inferred bindings. Paper: inference.tex, the SCC treatment of cycles (section introduction); the whole graph is one mutually recursive let. inferGraphTypes :: Typing.InferenceContext -> [Core.Binding] -> Graph.Graph -> Either Errors.Error ((Graph.Graph, [Core.Binding]), Typing.InferenceContext) inferGraphTypes fcx0 bindings0 g0 = @@ -283,12 +285,12 @@ Errors.otherInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace fcx2))), Errors.otherInferenceErrorMessage = "Expected a type scheme"})))) (\ts -> Right ((term1, ts), fcx2))))) (Left (Errors.ErrorInference (Errors.InferenceErrorOther (Errors.OtherInferenceError { Errors.otherInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace fcx2))), - Errors.otherInferenceErrorMessage = (Strings.cat [ + Errors.otherInferenceErrorMessage = (Strings.concat [ "Expected a single binding with a type scheme, but got: ", (Literals.showInt32 (Lists.length bindings)), " bindings"])})))))))))) --- | Infer the type of an annotated term (Either version) +-- | Infer the type of an annotated term (Either version). Paper: inference.tex, rule Ann. inferTypeOfAnnotatedTerm :: Typing.InferenceContext -> Graph.Graph -> Core.AnnotatedTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfAnnotatedTerm fcx cx at = @@ -310,7 +312,7 @@ Typing.inferenceResultClassConstraints = iconstraints, Typing.inferenceResultContext = fcx2})))) --- | Infer the type of a function application (Either version) +-- | Infer the type of a function application (Either version). Paper: inference.tex, rule App (elaboration form). inferTypeOfApplication :: Typing.InferenceContext -> Graph.Graph -> Core.Application -> Either Errors.Error Typing.InferenceResult inferTypeOfApplication fcx0 cx app = @@ -358,7 +360,7 @@ Typing.inferenceResultClassConstraints = rConstraints, Typing.inferenceResultContext = fcx4}))))))))) --- | Infer the type of a case statement (Either version) +-- | Infer the type of a case statement (Either version). Paper: inference.tex, rules Case and Case_d. inferTypeOfCaseStatement :: Typing.InferenceContext -> Graph.Graph -> Core.CaseStatement -> Either Errors.Error Typing.InferenceResult inferTypeOfCaseStatement fcx cx caseStmt = @@ -373,16 +375,15 @@ stype = Core.typeSchemeBody schemaType in (Eithers.bind (ExtractCore.unionType tname stype) (\sfields -> let fcxDflt = Names.pushSubtermStep Paths.SubtermStepUnionCasesDefault fcx2 - in (Eithers.bind (Eithers.mapOptional (\t -> inferTypeOfTerm fcxDflt cx t (Strings.cat [ + in (Eithers.bind (Eithers.mapOptional (\t -> inferTypeOfTerm fcxDflt cx t (Strings.concat [ "case ", (Core.unName tname), "."])) dflt) (\dfltRp -> let dfltResult = dfltRp - fcx3 = - Optionals.fromOptional fcx2 (Optionals.map (\_r -> Names.restoreTrace fcx2 (Typing.inferenceResultContext _r)) dfltRp) + fcx3 = Optionals.withDefault fcx2 (Optionals.map (\_r -> Names.restoreTrace fcx2 (Typing.inferenceResultContext _r)) dfltRp) in (Eithers.bind (inferMany fcx3 cx (Lists.map (\f -> ( Core.caseAlternativeHandler f, - (Strings.cat [ + (Strings.concat [ "case ", (Core.unName tname), ".", @@ -404,13 +405,13 @@ Typing.typeConstraintRight = (Substitution.substInType isubst (Typing.inferenceResultType r)), Typing.typeConstraintComment = "match default"}) dfltResult) caseConstraints = - Optionals.cat (Lists.zipWith (\fname -> \itype -> Optionals.map (\ftype -> Typing.TypeConstraint { + Optionals.givens (Lists.zipWith (\fname -> \itype -> Optionals.map (\ftype -> Typing.TypeConstraint { Typing.typeConstraintLeft = itype, Typing.typeConstraintRight = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = ftype, Core.functionTypeCodomain = cod})), Typing.typeConstraintComment = "case type"}) (Maps.lookup fname caseMap)) fnames itypes) - dfltClassConstraints = Optionals.fromOptional Maps.empty (Optionals.map Typing.inferenceResultClassConstraints dfltResult) + dfltClassConstraints = Optionals.withDefault Maps.empty (Optionals.map Typing.inferenceResultClassConstraints dfltResult) allElemConstraints = mergeClassConstraints caseElemConstraints dfltClassConstraints in (Eithers.bind (mapConstraints fcx5 cx (\subst -> yieldWithConstraints fcx5 (buildTypeApplicationTerm svars (Core.TermCases (Core.CaseStatement { Core.caseStatementTypeName = tname, @@ -427,7 +428,7 @@ dfltConstraints, caseConstraints])) (\mcResult -> Right mcResult)))))))))) --- | Infer the type of a collection. The classNames parameter specifies type classes (e.g. ordering) that the element type variable must satisfy. +-- | Infer the type of a collection. The classNames parameter specifies type classes (e.g. ordering) that the element type variable must satisfy. Paper: inference.tex, shared implementation of the collection introduction rules (Lst_0/Lst_+, Set_0/Set_+). inferTypeOfCollection :: Typing.InferenceContext -> Graph.Graph -> (Core.Type -> Core.Type) -> ([Core.Term] -> Core.Term) -> String -> S.Set Core.Name -> [Core.Term] -> Either Errors.Error Typing.InferenceResult inferTypeOfCollection fcx cx typCons trmCons desc classNames els = @@ -438,7 +439,7 @@ Logic.ifElse (Sets.null classNames) Maps.empty (Maps.singleton var (Core.TypeVariableConstraints { Core.typeVariableConstraintsClasses = (Lists.map (\n -> Core.TypeClassConstraintSimple n) (Sets.toList classNames))})) in (Logic.ifElse (Lists.null els) (Right (yieldWithConstraints fcx2 (buildTypeApplicationTerm [ - var] (trmCons [])) (typCons (Core.TypeVariable var)) Substitution.idTypeSubst classConstraints)) (Eithers.bind (inferMany fcx2 cx (Lists.zip els (Lists.map (\i -> Strings.cat [ + var] (trmCons [])) (typCons (Core.TypeVariable var)) Substitution.idTypeSubst classConstraints)) (Eithers.bind (inferMany fcx2 cx (Lists.zip els (Lists.map (\i -> Strings.concat [ "#", (Literals.showInt32 i)]) (Math.range 1 (Math.add (Lists.length els) 1))))) (\resultsRp -> let results = Pairs.first resultsRp @@ -459,7 +460,7 @@ isubst = Substitution.composeTypeSubst subst1 subst2 in (yieldWithConstraints fcx3 iterm itype isubst (Substitution.substInClassConstraints subst2 allConstraints))) constraints) (\mcResult -> Right mcResult))))) --- | Infer the type of an either value (Either version) +-- | Infer the type of an either value (Either version). Paper: inference.tex, rules Eith_L and Eith_R. inferTypeOfEither :: Typing.InferenceContext -> Graph.Graph -> Either Core.Term Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfEither fcx cx e = Eithers.either (\l -> Eithers.bind (inferTypeOfTerm fcx cx l "either left value") (\r1 -> @@ -506,7 +507,7 @@ Core.eitherTypeRight = rightType}) in (Right (yieldChecked fcx3 termWithBothTypes eitherType subst)))) e --- | Infer the type of a union injection (Either version) +-- | Infer the type of a union injection (Either version). Paper: inference.tex, rule Inj. inferTypeOfInjection :: Typing.InferenceContext -> Graph.Graph -> Core.Injection -> Either Errors.Error Typing.InferenceResult inferTypeOfInjection fcx cx injection = @@ -535,7 +536,7 @@ Typing.typeConstraintRight = ityp, Typing.typeConstraintComment = "schema type of injected field"}]) (\mcResult -> Right mcResult)))))))) --- | Infer the type of a lambda function (Either version) +-- | Infer the type of a lambda function (Either version). Paper: inference.tex, rule Abs (elaboration form). inferTypeOfLambda :: Typing.InferenceContext -> Graph.Graph -> Core.Lambda -> Either Errors.Error Typing.InferenceResult inferTypeOfLambda fcx cx lambda = @@ -583,7 +584,7 @@ Typing.inferenceResultClassConstraints = iconstraints, Typing.inferenceResultContext = fcx3})))) --- | Normalize a let term before inferring its type (Either version). The bindings are partitioned into strongly connected components and reorganized as nested lets, one let per SCC, in dependency order. This is the standard Hindley-Milner treatment of mutual recursion: each SCC is generalized once at its boundary (sound, because nothing inside the cluster sees a polymorphic instance of its siblings), and acyclic bindings generalize individually as usual. +-- | Normalize a let term before inferring its type (Either version). The bindings are partitioned into strongly connected components and reorganized as nested lets, one let per SCC, in dependency order. This is the standard Hindley-Milner treatment of mutual recursion: each SCC is generalized once at its boundary (sound, because nothing inside the cluster sees a polymorphic instance of its siblings), and acyclic bindings generalize individually as usual. Paper: inference.tex, the SCC treatment of cycles (section introduction) and the remark following the elaboration-form Let rule. inferTypeOfLet :: Typing.InferenceContext -> Graph.Graph -> Core.Let -> Either Errors.Error Typing.InferenceResult inferTypeOfLet fcx0 cx let0 = @@ -602,7 +603,7 @@ bindingMap = Maps.fromList (Lists.zip names bindings0) createLet = \e -> \group -> Core.TermLet (Core.Let { - Core.letBindings = (Optionals.cat (Lists.map (\n -> Maps.lookup n bindingMap) group)), + Core.letBindings = (Optionals.givens (Lists.map (\n -> Maps.lookup n bindingMap) group)), Core.letBody = e}) rewrittenLet = Lists.foldl createLet body0 (Lists.reverse groups) restoreLet = @@ -623,7 +624,7 @@ e = Pairs.second result bindingMap2 = Maps.fromList (Lists.map (\b -> (Core.bindingName b, b)) bindingList) in (Core.TermLet (Core.Let { - Core.letBindings = (Optionals.cat (Lists.map (\n -> Maps.lookup n bindingMap2) names)), + Core.letBindings = (Optionals.givens (Lists.map (\n -> Maps.lookup n bindingMap2) names)), Core.letBody = e})) rewriteResult = \iresult -> @@ -644,7 +645,7 @@ _ -> inferTypeOfTerm fcx cx rewrittenLet "empty let term" in (Eithers.map rewriteResult res) --- | Infer the type of a let (letrec) term which is already in a normal form (Either version) +-- | Infer the type of a let (letrec) term which is already in a normal form (Either version). Paper: inference.tex, rule Let (elaboration form). inferTypeOfLetNormalized :: Typing.InferenceContext -> Graph.Graph -> Core.Let -> Either Errors.Error Typing.InferenceResult inferTypeOfLetNormalized fcx0 cx0 letTerm = @@ -734,12 +735,12 @@ Typing.inferenceResultClassConstraints = allConstraints, Typing.inferenceResultContext = fcx4}))))))))) --- | Infer the type of a list (Either version) +-- | Infer the type of a list (Either version). Paper: inference.tex, rules Lst_0 and Lst_+. inferTypeOfList :: Typing.InferenceContext -> Graph.Graph -> [Core.Term] -> Either Errors.Error Typing.InferenceResult inferTypeOfList fcx cx = inferTypeOfCollection fcx cx (\x -> Core.TypeList x) (\x -> Core.TermList x) "list element" Sets.empty --- | Infer the type of a literal +-- | Infer the type of a literal. Paper: inference.tex, rule Lit. inferTypeOfLiteral :: Typing.InferenceContext -> Core.Literal -> Typing.InferenceResult inferTypeOfLiteral fcx lit = Typing.InferenceResult { @@ -749,7 +750,7 @@ Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} --- | Infer the type of a map (Either version) +-- | Infer the type of a map (Either version). Paper: inference.tex, rules Map_0 and Map_+. inferTypeOfMap :: Typing.InferenceContext -> Graph.Graph -> M.Map Core.Term Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfMap fcx cx m = @@ -801,14 +802,14 @@ kcons, vcons])) (\mcResult -> Right mcResult))))))) --- | Infer the type of a Maybe value +-- | Infer the type of a Maybe value. Paper: inference.tex, rules Opt_0 and Opt_1. inferTypeOfOptional :: Typing.InferenceContext -> Graph.Graph -> Maybe Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfOptional fcx cx m = - let trmCons = \terms -> Core.TermOptional (Lists.maybeHead terms) + let trmCons = \terms -> Core.TermOptional (Lists.head terms) in (inferTypeOfCollection fcx cx (\x -> Core.TypeOptional x) trmCons "optional element" Sets.empty (Optionals.cases m [] Lists.singleton)) --- | Infer the type of a pair (Either version) +-- | Infer the type of a pair (Either version). Paper: inference.tex, rule Pair. inferTypeOfPair :: Typing.InferenceContext -> Graph.Graph -> (Core.Term, Core.Term) -> Either Errors.Error Typing.InferenceResult inferTypeOfPair fcx cx p = Eithers.bind (inferMany fcx cx [ @@ -832,18 +833,7 @@ Core.pairTypeFirst = tyFst, Core.pairTypeSecond = tySnd})) isubst pairElemConstraints)))))))) --- | Infer the type of a primitive function (Either version) -inferTypeOfPrimitive :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> Either Errors.Error Typing.InferenceResult -inferTypeOfPrimitive fcx cx name = - Optionals.cases (Optionals.map (\_p -> Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition _p))) (Maps.lookup name (Graph.graphPrimitives cx))) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchPrimitive (Errors.NoSuchPrimitiveError { - Errors.noSuchPrimitiveErrorName = name})))) (\scheme -> - let tsResult = Resolution.instantiateTypeScheme fcx scheme - ts = Pairs.first tsResult - fcx2 = Pairs.second tsResult - constraints = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints ts) - in (Right (yieldCheckedWithConstraints fcx2 (buildTypeApplicationTerm (Core.typeSchemeVariables ts) (Core.TermVariable name)) (Core.typeSchemeBody ts) Substitution.idTypeSubst constraints))) - --- | Infer the type of a record projection (Either version) +-- | Infer the type of a record projection (Either version). Paper: inference.tex, rule Proj. inferTypeOfProjection :: Typing.InferenceContext -> Graph.Graph -> Core.Projection -> Either Errors.Error Typing.InferenceResult inferTypeOfProjection fcx cx proj = @@ -860,7 +850,7 @@ Core.functionTypeDomain = (Resolution.nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)), Core.functionTypeCodomain = ftyp})) Substitution.idTypeSubst)))))) --- | Infer the type of a record (Either version) +-- | Infer the type of a record (Either version). Paper: inference.tex, rule Rec. inferTypeOfRecord :: Typing.InferenceContext -> Graph.Graph -> Core.Record -> Either Errors.Error Typing.InferenceResult inferTypeOfRecord fcx cx record = @@ -870,7 +860,7 @@ in (Eithers.bind (Resolution.requireSchemaType fcx (Graph.graphSchemaTypes cx) tname) (\stRp -> let schemaType = Pairs.first stRp fcx2 = Pairs.second stRp - in (Eithers.bind (inferMany fcx2 cx (Lists.map (\f -> (Core.fieldTerm f, (Strings.cat2 "field " (Core.unName (Core.fieldName f))))) fields)) (\rp -> + in (Eithers.bind (inferMany fcx2 cx (Lists.map (\f -> (Core.fieldTerm f, (Strings.concat2 "field " (Core.unName (Core.fieldName f))))) fields)) (\rp -> let results = Pairs.first rp fcx3 = Pairs.second rp svars = Core.typeSchemeVariables schemaType @@ -893,7 +883,7 @@ Typing.typeConstraintRight = ityp, Typing.typeConstraintComment = "schema type of record"}]) (\mcResult -> Right mcResult)))))) --- | Infer the type of a set (Either version) +-- | Infer the type of a set (Either version). Paper: inference.tex, rules Set_0 and Set_+. inferTypeOfSet :: Typing.InferenceContext -> Graph.Graph -> S.Set Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfSet fcx cx s = inferTypeOfCollection fcx cx (\x -> Core.TypeSet x) (\terms -> Core.TermSet (Sets.fromList terms)) "set element" (Sets.singleton (Core.Name "ordering")) (Sets.toList s) @@ -926,7 +916,7 @@ Core.TermVariable v0 -> inferTypeOfVariable fcx2 cx v0 Core.TermWrap v0 -> inferTypeOfWrappedTerm fcx2 cx v0 --- | Infer the type of a type application (Either version) +-- | Infer the type of a type application (Either version). Paper: inference.tex, type application terms in the elaborated Term grammar. inferTypeOfTypeApplication :: Typing.InferenceContext -> Graph.Graph -> Core.TypeApplicationTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfTypeApplication fcx cx tt = @@ -940,7 +930,7 @@ Typing.inferenceResultClassConstraints = (Typing.inferenceResultClassConstraints result), Typing.inferenceResultContext = fcx2})))) --- | Infer the type of a type abstraction (Either version) +-- | Infer the type of a type abstraction (Either version). Paper: inference.tex, type abstraction terms in the elaborated Term grammar. inferTypeOfTypeLambda :: Typing.InferenceContext -> Graph.Graph -> Core.TypeLambda -> Either Errors.Error Typing.InferenceResult inferTypeOfTypeLambda fcx cx ta = @@ -954,7 +944,7 @@ Typing.inferenceResultClassConstraints = (Typing.inferenceResultClassConstraints result), Typing.inferenceResultContext = fcx2})))) --- | The trivial inference rule for the unit term +-- | The trivial inference rule for the unit term. Paper: inference.tex, rule Unit. inferTypeOfUnit :: Typing.InferenceContext -> Typing.InferenceResult inferTypeOfUnit fcx = Typing.InferenceResult { @@ -964,7 +954,7 @@ Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} --- | Infer the type of an unwrap operation (Either version) +-- | Infer the type of an unwrap operation (Either version). Paper: inference.tex, rule Unwr. inferTypeOfUnwrap :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> Either Errors.Error Typing.InferenceResult inferTypeOfUnwrap fcx cx tname = Eithers.bind (Resolution.requireSchemaType fcx (Graph.graphSchemaTypes cx) tname) (\stRp -> @@ -976,7 +966,7 @@ Core.functionTypeDomain = (Resolution.nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)), Core.functionTypeCodomain = wtyp})) Substitution.idTypeSubst)))) --- | Infer the type of a variable (Either version) +-- | Infer the type of a variable (Either version). Paper: inference.tex, rule Var (elaboration form), with rule Prim as the primitive-namespace fallback. inferTypeOfVariable :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> Either Errors.Error Typing.InferenceResult inferTypeOfVariable fcx cx name = Optionals.cases (Maps.lookup name (Graph.graphBoundTypes cx)) (Optionals.cases (Optionals.map (\_p -> Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition _p))) (Maps.lookup name (Graph.graphPrimitives cx))) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchBinding (Errors.NoSuchBindingError { @@ -984,12 +974,12 @@ let tsResult = Resolution.instantiateTypeScheme fcx scheme ts = Pairs.first tsResult fcx2 = Pairs.second tsResult - constraints = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints ts) + constraints = Optionals.withDefault Maps.empty (Core.typeSchemeConstraints ts) in (Right (yieldCheckedWithConstraints fcx2 (buildTypeApplicationTerm (Core.typeSchemeVariables ts) (Core.TermVariable name)) (Core.typeSchemeBody ts) Substitution.idTypeSubst constraints)))) (\scheme -> let tsResult = Resolution.instantiateTypeScheme fcx scheme ts = Pairs.first tsResult fcx2 = Pairs.second tsResult - constraints = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints ts) + constraints = Optionals.withDefault Maps.empty (Core.typeSchemeConstraints ts) in (Right (Typing.InferenceResult { Typing.inferenceResultTerm = (buildTypeApplicationTerm (Core.typeSchemeVariables ts) (Core.TermVariable name)), Typing.inferenceResultType = (Core.typeSchemeBody ts), @@ -997,7 +987,7 @@ Typing.inferenceResultClassConstraints = constraints, Typing.inferenceResultContext = fcx2}))) --- | Infer the type of a wrapped term (Either version) +-- | Infer the type of a wrapped term (Either version). Paper: inference.tex, rule Wrp. inferTypeOfWrappedTerm :: Typing.InferenceContext -> Graph.Graph -> Core.WrappedTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfWrappedTerm fcx cx wt = @@ -1036,7 +1026,7 @@ k = Core.bindingName binding v = Core.bindingTerm binding fcxBind = Names.pushSubtermStep (Paths.SubtermStepLetBinding k) fcx - in (Eithers.bind (inferTypeOfTerm fcxBind cx v (Strings.cat [ + in (Eithers.bind (inferTypeOfTerm fcxBind cx v (Strings.concat [ "temporary let binding '", (Core.unName k), "'"])) (\result1 -> @@ -1048,7 +1038,7 @@ in (Eithers.bind (Optionals.cases (Core.bindingTypeScheme binding) (Right Maps.empty) (\ts -> let tsResult = Resolution.instantiateTypeScheme fcx2 ts instantiatedTs = Pairs.first tsResult - freshConstraints = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints instantiatedTs) + freshConstraints = Optionals.withDefault Maps.empty (Core.typeSchemeConstraints instantiatedTs) in (Eithers.bind (Eithers.bimap (\_e -> Errors.ErrorInference (Errors.InferenceErrorUnification (Errors.UnificationInferenceError { Errors.unificationInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace fcx2))), Errors.unificationInferenceErrorCause = _e}))) (\_a -> _a) (Unification.unifyTypes fcx2 (Graph.graphSchemaTypes cx) (Core.typeSchemeBody instantiatedTs) u_prime "original binding type")) (\unifySubst -> Right (Substitution.substInClassConstraints unifySubst freshConstraints))))) (\originalBindingConstraints -> @@ -1090,7 +1080,7 @@ in (Optionals.cases (Maps.lookup k acc) (Maps.insert k v acc) (\existing -> let merged = Core.TypeVariableConstraints { - Core.typeVariableConstraintsClasses = (Lists.nub (Lists.concat2 (Core.typeVariableConstraintsClasses existing) (Core.typeVariableConstraintsClasses v)))} + Core.typeVariableConstraintsClasses = (Lists.distinct (Lists.concat2 (Core.typeVariableConstraintsClasses existing) (Core.typeVariableConstraintsClasses v)))} in (Maps.insert k merged acc)))) m1 (Maps.toList m2) -- | Show an inference result for debugging @@ -1100,13 +1090,13 @@ let term = Typing.inferenceResultTerm result typ = Typing.inferenceResultType result subst = Typing.inferenceResultSubst result - in (Strings.cat [ + in (Strings.concat [ "{term=", - (ShowCore.term term), + (PrintCore.term term), ", type=", - (ShowCore.type_ typ), + (PrintCore.type_ typ), ", subst=", - (ShowTyping.typeSubst subst), + (PrintTyping.typeSubst subst), "}"]) -- | Create an inference result with no class constraints diff --git a/src/main/haskell/Hydra/Json/Decode.hs b/src/main/haskell/Hydra/Json/Decode.hs --- a/src/main/haskell/Hydra/Json/Decode.hs +++ b/src/main/haskell/Hydra/Json/Decode.hs @@ -31,10 +31,12 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -55,13 +57,13 @@ case ft of Core.FloatTypeFloat32 -> case value of Model.ValueNumber v1 -> Right (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 (LibLiterals.decimalToFloat32 v1)))) - Model.ValueString v1 -> Optionals.cases (parseSpecialFloat32 v1) (Left (Strings.cat [ + Model.ValueString v1 -> Optionals.cases (parseSpecialFloat32 v1) (Left (Strings.concat [ "invalid float32 sentinel: ", v1])) (\v -> Right (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 v)))) _ -> Left "expected number or special float string for float32" Core.FloatTypeFloat64 -> case value of Model.ValueNumber v1 -> Right (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 (LibLiterals.decimalToFloat64 v1)))) - Model.ValueString v1 -> Optionals.cases (parseSpecialFloat v1) (Left (Strings.cat [ + Model.ValueString v1 -> Optionals.cases (parseSpecialFloat v1) (Left (Strings.concat [ "invalid float64 sentinel: ", v1])) (\v -> Right (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v)))) _ -> Left "expected number or special float string for float64" @@ -74,21 +76,21 @@ let strResult = expectString value in (Eithers.either (\err -> Left err) (\s -> let parsed = LibLiterals.readBigint s - in (Optionals.cases parsed (Left (Strings.cat [ + in (Optionals.cases parsed (Left (Strings.concat [ "invalid bigint: ", s])) (\v -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueBigint v)))))) strResult) Core.IntegerTypeInt64 -> let strResult = expectString value in (Eithers.either (\err -> Left err) (\s -> let parsed = LibLiterals.readInt64 s - in (Optionals.cases parsed (Left (Strings.cat [ + in (Optionals.cases parsed (Left (Strings.concat [ "invalid int64: ", s])) (\v -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 v)))))) strResult) Core.IntegerTypeUint64 -> let strResult = expectString value in (Eithers.either (\err -> Left err) (\s -> let parsed = LibLiterals.readUint64 s - in (Optionals.cases parsed (Left (Strings.cat [ + in (Optionals.cases parsed (Left (Strings.concat [ "invalid uint64: ", s])) (\v -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 v)))))) strResult) Core.IntegerTypeInt8 -> @@ -110,7 +112,7 @@ Model.ValueNumber v1 -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 (LibLiterals.bigintToUint32 (LibLiterals.decimalToBigint v1))))) Model.ValueString v1 -> let parsed = LibLiterals.readUint32 v1 - in (Optionals.cases parsed (Left (Strings.cat [ + in (Optionals.cases parsed (Left (Strings.concat [ "invalid uint32: ", v1])) (\v -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 v))))) _ -> Left "expected number or string for uint32" @@ -121,7 +123,7 @@ case lt of Core.LiteralTypeBinary -> let strResult = expectString value - in (Eithers.map (\s -> Core.TermLiteral (Core.LiteralBinary (LibLiterals.stringToBinary s))) strResult) + in (Eithers.map (\s -> Core.TermLiteral (Core.LiteralBinary (LibLiterals.base64ToBinary s))) strResult) Core.LiteralTypeBoolean -> case value of Model.ValueBoolean v1 -> Right (Core.TermLiteral (Core.LiteralBoolean v1)) _ -> Left "expected boolean" @@ -167,7 +169,28 @@ fromJson types tname typ value = let stripped = Strip.deannotateType typ + reduceApp = + \app -> + let fn = Strip.deannotateType (Core.applicationTypeFunction app) + arg = Core.applicationTypeArgument app + in case fn of + Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedFn -> reduceApp (Core.ApplicationType { + Core.applicationTypeFunction = reducedFn, + Core.applicationTypeArgument = arg})) (reduceApp v0) + Core.TypeForall v0 -> Right (Substitution.substInType (Substitution.singletonTypeSubst (Core.forallTypeParameter v0) arg) (Core.forallTypeBody v0)) + Core.TypeVariable v0 -> + let lookedUp = Maps.lookup v0 types + in (Optionals.cases lookedUp (Left (Strings.concat [ + "unknown type variable: ", + (Core.unName v0)])) (\resolvedFn -> reduceApp (Core.ApplicationType { + Core.applicationTypeFunction = resolvedFn, + Core.applicationTypeArgument = arg}))) + _ -> Left (Strings.concat [ + "cannot apply a non-parametric type: ", + (PrintCore.type_ fn)]) in case stripped of + Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> fromJson types tname reducedType value) (reduceApp v0) + Core.TypeForall v0 -> fromJson types tname (Core.forallTypeBody v0) value Core.TypeLiteral v0 -> decodeLiteral v0 value Core.TypeList v0 -> let decodeElem = \v -> fromJson types tname v0 v @@ -189,7 +212,7 @@ _ -> False in (Logic.ifElse isNestedMaybe ( let decodeJust = - \arr -> Optionals.cases (Lists.maybeHead arr) (Left "expected single-element array for Just") (\firstVal -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types tname v0 firstVal)) + \arr -> Optionals.cases (Lists.head arr) (Left "expected single-element array for Just") (\firstVal -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types tname v0 firstVal)) decodeMaybeArray = \arr -> let len = Lists.length arr @@ -209,7 +232,7 @@ ftype = Core.fieldTypeType ft mval = Maps.lookup (Core.unName fname) obj defaultVal = Model.ValueNull - jsonVal = Optionals.fromOptional defaultVal mval + jsonVal = Optionals.withDefault defaultVal mval decoded = fromJson types tname ftype jsonVal in (Eithers.map (\v -> Core.Field { Core.fieldName = fname, @@ -221,7 +244,7 @@ Core.TypeUnion v0 -> let decodeVariant = \key -> \val -> \ftype -> - let jsonVal = Optionals.fromOptional Model.ValueNull val + let jsonVal = Optionals.withDefault Model.ValueNull val decoded = fromJson types tname ftype jsonVal in (Eithers.map (\v -> Core.TermInject (Core.Injection { Core.injectionTypeName = tname, @@ -229,15 +252,15 @@ Core.fieldName = (Core.Name key), Core.fieldTerm = v}})) decoded) findAndDecode = - \key -> \val -> \fts -> Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) key) fts) (Left (Strings.cat [ + \key -> \val -> \fts -> Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) key) fts) (Left (Strings.concat [ "unknown variant: ", key])) (\ft -> decodeVariant key val (Core.fieldTypeType ft)) decodeSingleKey = - \obj -> Optionals.cases (Lists.maybeHead (Maps.keys obj)) (Left "expected single-key object for union") (\k -> findAndDecode k (Maps.lookup k obj) v0) + \obj -> Optionals.cases (Lists.head (Maps.keys obj)) (Left "expected single-key object for union") (\k -> findAndDecode k (Maps.lookup k obj) v0) processUnion = \obj -> Logic.ifElse (Equality.equal (Lists.length (Maps.keys obj)) 1) (decodeSingleKey obj) (Left "expected single-key object for union") decodeCompactString = - \s -> Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) s) v0) (Left (Strings.cat [ + \s -> Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) s) v0) (Left (Strings.concat [ "unknown variant: ", s])) (\ft -> let ftypeStripped = Strip.deannotateType (Core.fieldTypeType ft) @@ -247,7 +270,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name s), Core.fieldTerm = Core.TermUnit}})) - _ -> Left (Strings.cat [ + _ -> Left (Strings.concat [ "compact string form requires unit-typed variant, got non-unit type for variant: ", s])) in case value of @@ -306,12 +329,12 @@ in (Eithers.map (\v -> Core.TermEither (Left v)) decoded)))) objResult) Core.TypeVariable v0 -> let lookedUp = Maps.lookup v0 types - in (Optionals.cases lookedUp (Left (Strings.cat [ + in (Optionals.cases lookedUp (Left (Strings.concat [ "unknown type variable: ", (Core.unName v0)])) (\resolvedType -> fromJson types v0 resolvedType value)) - _ -> Left (Strings.cat [ + _ -> Left (Strings.concat [ "unsupported type for JSON decoding: ", - (ShowCore.type_ typ)]) + (PrintCore.type_ typ)]) -- | Parse an IEEE sentinel string (NaN, Infinity, -Infinity, -0.0) to a float64. Returns Nothing for unrecognized strings. parseSpecialFloat :: String -> Maybe Double diff --git a/src/main/haskell/Hydra/Json/Decoding.hs b/src/main/haskell/Hydra/Json/Decoding.hs --- a/src/main/haskell/Hydra/Json/Decoding.hs +++ b/src/main/haskell/Hydra/Json/Decoding.hs @@ -25,6 +25,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -57,7 +58,7 @@ -- | Decode a required field from a JSON object decodeField :: (t0 -> Either String t1) -> String -> M.Map String t0 -> Either String t1 decodeField decodeValue name m = - Eithers.bind (decodeOptionalField decodeValue name m) (\mf -> Optionals.cases mf (Left (Strings.cat2 "missing field: " name)) (\f -> Right f)) + Eithers.bind (decodeOptionalField decodeValue name m) (\mf -> Optionals.cases mf (Left (Strings.concat2 "missing field: " name)) (\f -> Right f)) -- | Decode a JSON object value to a name-keyed map. Field order is not preserved; decoding looks fields up by name. decodeObject :: Model.Value -> Either String (M.Map String Model.Value) diff --git a/src/main/haskell/Hydra/Json/Encode.hs b/src/main/haskell/Hydra/Json/Encode.hs --- a/src/main/haskell/Hydra/Json/Encode.hs +++ b/src/main/haskell/Hydra/Json/Encode.hs @@ -32,10 +32,12 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore import qualified Hydra.Strip as Strip +import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -79,7 +81,7 @@ encodeLiteral :: Core.Literal -> Either t0 Model.Value encodeLiteral lit = case lit of - Core.LiteralBinary v0 -> Right (Model.ValueString (LibLiterals.binaryToString v0)) + Core.LiteralBinary v0 -> Right (Model.ValueString (LibLiterals.binaryToBase64 v0)) Core.LiteralBoolean v0 -> Right (Model.ValueBoolean v0) Core.LiteralDecimal v0 -> Right (Model.ValueNumber v0) Core.LiteralFloat v0 -> encodeFloat v0 @@ -97,7 +99,28 @@ let stripped = Strip.deannotateType typ strippedTerm = Strip.deannotateTerm term + reduceApp = + \app -> + let fn = Strip.deannotateType (Core.applicationTypeFunction app) + arg = Core.applicationTypeArgument app + in case fn of + Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedFn -> reduceApp (Core.ApplicationType { + Core.applicationTypeFunction = reducedFn, + Core.applicationTypeArgument = arg})) (reduceApp v0) + Core.TypeForall v0 -> Right (Substitution.substInType (Substitution.singletonTypeSubst (Core.forallTypeParameter v0) arg) (Core.forallTypeBody v0)) + Core.TypeVariable v0 -> + let lookedUp = Maps.lookup v0 types + in (Optionals.cases lookedUp (Left (Strings.concat [ + "unknown type variable: ", + (Core.unName v0)])) (\resolvedFn -> reduceApp (Core.ApplicationType { + Core.applicationTypeFunction = resolvedFn, + Core.applicationTypeArgument = arg}))) + _ -> Left (Strings.concat [ + "cannot apply a non-parametric type: ", + (PrintCore.type_ fn)]) in case stripped of + Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> toJson types tname reducedType term) (reduceApp v0) + Core.TypeForall v0 -> toJson types tname (Core.forallTypeBody v0) term Core.TypeLiteral _ -> case strippedTerm of Core.TermLiteral v1 -> encodeLiteral v1 _ -> Left "expected literal term" @@ -152,7 +175,7 @@ fields = Core.recordFields v1 encodedPairs = Eithers.mapList (\ftf -> encodeFieldWithType (Pairs.first ftf) (Pairs.second ftf)) (Lists.zip fieldTypes fields) - in (Eithers.map (\pairs -> Model.ValueObject (Optionals.cat pairs)) encodedPairs) + in (Eithers.map (\pairs -> Model.ValueObject (Optionals.givens pairs)) encodedPairs) _ -> Left "expected record term" Core.TypeUnion v0 -> case strippedTerm of Core.TermInject v1 -> @@ -160,7 +183,7 @@ fname = Core.unName (Core.fieldName field) fterm = Core.fieldTerm field ftypeResult = - Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) fname) v0) (Left (Strings.cat [ + Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) fname) v0) (Left (Strings.concat [ "unknown variant: ", fname])) (\ft -> Right (Core.fieldTypeType ft)) in (Eithers.either (\err -> Left err) (\ftype -> @@ -223,9 +246,9 @@ Core.TypeVariable v0 -> let lookedUp = Maps.lookup v0 types in (Optionals.cases lookedUp (toJsonUntyped term) (\resolvedType -> toJson types v0 resolvedType term)) - _ -> Left (Strings.cat [ + _ -> Left (Strings.concat [ "unsupported type for JSON encoding: ", - (ShowCore.type_ typ)]) + (PrintCore.type_ typ)]) -- | Encode a Hydra term to a JSON value without type information. Falls back to array-wrapped Maybe encoding. toJsonUntyped :: Core.Term -> Either String Model.Value @@ -297,6 +320,6 @@ let encodedR = toJsonUntyped r in (Eithers.map (\v -> Model.ValueObject [ ("right", v)]) encodedR)) v0 - _ -> Left (Strings.cat [ + _ -> Left (Strings.concat [ "unsupported term variant for JSON encoding: ", - (ShowCore.term term)]) + (PrintCore.term term)]) diff --git a/src/main/haskell/Hydra/Json/Parser.hs b/src/main/haskell/Hydra/Json/Parser.hs --- a/src/main/haskell/Hydra/Json/Parser.hs +++ b/src/main/haskell/Hydra/Json/Parser.hs @@ -18,16 +18,19 @@ import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as Model import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Functions as Functions import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsers as Parsers import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -45,7 +48,7 @@ -- | Parse a single digit (0-9) digit :: Parsing.Parser Int -digit = Parsers.satisfy (\c -> Logic.and (Equality.gte c 48) (Equality.lte c 57)) +digit = Parsers.satisfy (\c -> Logic.and (Ordering.gte c 48) (Ordering.lte c 57)) -- | Parse one or more digits as a string digits :: Parsing.Parser String @@ -77,16 +80,16 @@ -- | Parse the optional exponent part of a JSON number jsonExponentPart :: Parsing.Parser (Maybe String) jsonExponentPart = - Parsers.optional (Parsers.bind (Parsers.satisfy (\c -> Logic.or (Equality.equal c 101) (Equality.equal c 69))) (\_ -> Parsers.bind (Parsers.optional (Parsers.satisfy (\c -> Logic.or (Equality.equal c 43) (Equality.equal c 45)))) (\sign -> Parsers.map (\digits -> Strings.cat2 (Strings.cat2 "e" (Optionals.cases sign "" (\arg_ -> Strings.fromList (Lists.pure arg_)))) digits) digits))) + Parsers.optional (Parsers.bind (Parsers.satisfy (\c -> Logic.or (Equality.equal c 101) (Equality.equal c 69))) (\_ -> Parsers.bind (Parsers.optional (Parsers.satisfy (\c -> Logic.or (Equality.equal c 43) (Equality.equal c 45)))) (\sign -> Parsers.map (\digits -> Strings.concat2 (Strings.concat2 "e" (Optionals.cases sign "" (\arg_ -> Strings.fromList (Lists.pure arg_)))) digits) digits))) -- | Parse the optional fractional part of a JSON number jsonFractionPart :: Parsing.Parser (Maybe String) -jsonFractionPart = Parsers.optional (Parsers.bind (Parsers.char 46) (\_ -> Parsers.map (\d -> Strings.cat2 "." d) digits)) +jsonFractionPart = Parsers.optional (Parsers.bind (Parsers.char 46) (\_ -> Parsers.map (\d -> Strings.concat2 "." d) digits)) -- | Parse the integer part of a JSON number (optional minus, then digits) jsonIntegerPart :: Parsing.Parser String jsonIntegerPart = - Parsers.bind (Parsers.optional (Parsers.char 45)) (\sign -> Parsers.bind digits (\digits -> Parsers.pure (Optionals.cases sign digits (\_ -> Strings.cat2 "-" digits)))) + Parsers.bind (Parsers.optional (Parsers.char 45)) (\sign -> Parsers.bind digits (\digits -> Parsers.pure (Optionals.cases sign digits (\_ -> Strings.concat2 "-" digits)))) -- | Parse a JSON object key-value pair jsonKeyValue :: Parsing.Parser (String, Model.Value) @@ -102,8 +105,8 @@ jsonNumber = token (Parsers.bind jsonIntegerPart (\intPart -> Parsers.bind jsonFractionPart (\fracPart -> Parsers.bind jsonExponentPart (\expPart -> let numStr = - Strings.cat2 (Strings.cat2 intPart (Optionals.cases fracPart "" Equality.identity)) (Optionals.cases expPart "" Equality.identity) - in (Parsers.pure (Model.ValueNumber (Optionals.cases (Literals.readDecimal numStr) (Literals.stringToDecimal "0.0") Equality.identity))))))) + Strings.concat2 (Strings.concat2 intPart (Optionals.cases fracPart "" Functions.identity)) (Optionals.cases expPart "" Functions.identity) + in (Parsers.pure (Model.ValueNumber (Optionals.cases (Literals.readDecimal numStr) (Literals.stringToDecimal "0.0") Functions.identity))))))) -- | Parse a JSON object jsonObject :: Parsing.Parser Model.Value diff --git a/src/main/haskell/Hydra/Json/Writer.hs b/src/main/haskell/Hydra/Json/Writer.hs --- a/src/main/haskell/Hydra/Json/Writer.hs +++ b/src/main/haskell/Hydra/Json/Writer.hs @@ -23,12 +23,14 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Serialization as Serialization import qualified Hydra.System as System @@ -60,20 +62,20 @@ hexByte c = let nibble = - \i -> Optionals.fromOptional "?" (Optionals.map (\ch -> Strings.fromList (Lists.pure ch)) (Strings.maybeCharAt i "0123456789abcdef")) - hi = nibble (Optionals.fromOptional 0 (Math.maybeDiv c 16)) - lo = nibble (Optionals.fromOptional 0 (Math.maybeMod c 16)) - in (Strings.cat2 hi lo) + \i -> Optionals.withDefault "?" (Optionals.map (\ch -> Strings.fromList (Lists.pure ch)) (Strings.charAt i "0123456789abcdef")) + hi = nibble (Optionals.withDefault 0 (Math.div c 16)) + lo = nibble (Optionals.withDefault 0 (Math.mod c 16)) + in (Strings.concat2 hi lo) -- | Escape and quote a string for JSON output jsonString :: String -> String jsonString s = - let hexEscape = \c -> Strings.cat2 "\\u00" (hexByte c) + let hexEscape = \c -> Strings.concat2 "\\u00" (hexByte c) escape = - \c -> Logic.ifElse (Equality.equal c 34) "\\\"" (Logic.ifElse (Equality.equal c 92) "\\\\" (Logic.ifElse (Equality.equal c 8) "\\b" (Logic.ifElse (Equality.equal c 12) "\\f" (Logic.ifElse (Equality.equal c 10) "\\n" (Logic.ifElse (Equality.equal c 13) "\\r" (Logic.ifElse (Equality.equal c 9) "\\t" (Logic.ifElse (Equality.lt c 32) (hexEscape c) (Strings.fromList (Lists.pure c))))))))) - escaped = Strings.cat (Lists.map escape (Strings.toList s)) - in (Strings.cat2 (Strings.cat2 "\"" escaped) "\"") + \c -> Logic.ifElse (Equality.equal c 34) "\\\"" (Logic.ifElse (Equality.equal c 92) "\\\\" (Logic.ifElse (Equality.equal c 8) "\\b" (Logic.ifElse (Equality.equal c 12) "\\f" (Logic.ifElse (Equality.equal c 10) "\\n" (Logic.ifElse (Equality.equal c 13) "\\r" (Logic.ifElse (Equality.equal c 9) "\\t" (Logic.ifElse (Ordering.lt c 32) (hexEscape c) (Strings.fromList (Lists.pure c))))))))) + escaped = Strings.concat (Lists.map escape (Strings.toList s)) + in (Strings.concat2 (Strings.concat2 "\"" escaped) "\"") -- | Convert a key-value pair to an AST expression keyValueToExpr :: (String, Model.Value) -> Ast.Expr @@ -99,6 +101,6 @@ shown = Literals.showDecimal v0 isWhole = Equality.equal v0 (Literals.bigintToDecimal rounded) plain = Literals.showBigint rounded - in (Serialization.cst (Logic.ifElse (Logic.and isWhole (Equality.lte (Strings.length plain) (Strings.length shown))) plain shown)) + in (Serialization.cst (Logic.ifElse (Logic.and isWhole (Ordering.lte (Strings.length plain) (Strings.length shown))) plain shown)) Model.ValueObject v0 -> Serialization.bracesListAdaptive (Lists.map keyValueToExpr v0) Model.ValueString v0 -> Serialization.cst (jsonString v0) diff --git a/src/main/haskell/Hydra/Json/Yaml/Decode.hs b/src/main/haskell/Hydra/Json/Yaml/Decode.hs --- a/src/main/haskell/Hydra/Json/Yaml/Decode.hs +++ b/src/main/haskell/Hydra/Json/Yaml/Decode.hs @@ -26,6 +26,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Json/Yaml/Encode.hs b/src/main/haskell/Hydra/Json/Yaml/Encode.hs --- a/src/main/haskell/Hydra/Json/Yaml/Encode.hs +++ b/src/main/haskell/Hydra/Json/Yaml/Encode.hs @@ -26,6 +26,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Kernel.hs b/src/main/haskell/Hydra/Kernel.hs --- a/src/main/haskell/Hydra/Kernel.hs +++ b/src/main/haskell/Hydra/Kernel.hs @@ -6,12 +6,12 @@ - Hydra.Encode.Core - Hydra.Extract.Core - Hydra.Extract.Util -- Hydra.Show.Variants +- Hydra.Print.Variants - Hydra.Codegen - Hydra.Json.Parser - Hydra.Json.Writer - Hydra.Parsers -- Hydra.Show.Core +- Hydra.Print.Core - Hydra.Topology -} diff --git a/src/main/haskell/Hydra/Languages.hs b/src/main/haskell/Hydra/Languages.hs --- a/src/main/haskell/Hydra/Languages.hs +++ b/src/main/haskell/Hydra/Languages.hs @@ -23,6 +23,7 @@ import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Lexical.hs b/src/main/haskell/Hydra/Lexical.hs --- a/src/main/haskell/Hydra/Lexical.hs +++ b/src/main/haskell/Hydra/Lexical.hs @@ -25,17 +25,19 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -62,7 +64,7 @@ mergedTerms = Maps.union elementTerms letTerms filteredTerms = Maps.filterWithKey (\k -> \_v -> Logic.not (Maps.member k primitives)) mergedTerms elementTypes = - Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) elements)) + Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) elements)) filteredTypes = Maps.filterWithKey (\k -> \_v -> Logic.not (Maps.member k primitives)) elementTypes in Graph.Graph { Graph.graphBoundTerms = filteredTerms, @@ -80,7 +82,7 @@ let tryName = \index -> - let candidate = Logic.ifElse (Equality.equal index 1) name (Core.Name (Strings.cat2 (Core.unName name) (Literals.showInt32 index))) + let candidate = Logic.ifElse (Equality.equal index 1) name (Core.Name (Strings.concat2 (Core.unName name) (Literals.showInt32 index))) in (Logic.ifElse (Sets.member candidate reserved) (tryName (Math.add index 1)) candidate) in (tryName 1) @@ -213,7 +215,7 @@ Core.TermRecord v0 -> decode (Maps.fromList (Lists.map (\field -> (Core.fieldName field, (Core.fieldTerm field))) (Core.recordFields v0))) _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record", - Errors.unexpectedShapeErrorActual = (ShowCore.term term)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.term term)}))) -- | Match a term against a union type, dispatching on the injected variant to the appropriate decoder. Variable terms are dereferenced through the graph before matching. matchUnion :: Graph.Graph -> Core.Name -> [(Core.Name, (Core.Term -> Either Errors.Error t0))] -> Core.Term -> Either Errors.Error t0 @@ -231,11 +233,11 @@ in (Optionals.cases (Maps.lookup fname mapping) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoMatchingField (Errors.NoMatchingFieldError { Errors.noMatchingFieldErrorFieldName = fname})))) (\f -> f val)) in (Logic.ifElse (Equality.equal (Core.unName (Core.injectionTypeName v0)) (Core.unName tname)) exp (Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "injection for type " (Core.unName tname)), - Errors.unexpectedShapeErrorActual = (ShowCore.term term)}))))) + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "injection for type " (Core.unName tname)), + Errors.unexpectedShapeErrorActual = (PrintCore.term term)}))))) _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 "injection for type " (Core.unName tname)), - Errors.unexpectedShapeErrorActual = (ShowCore.term stripped)}))) + Errors.unexpectedShapeErrorExpected = (Strings.concat2 "injection for type " (Core.unName tname)), + Errors.unexpectedShapeErrorActual = (PrintCore.term stripped)}))) -- | Build a (fieldName, decoder) pair for a unit-valued union variant: the decoder ignores its argument and returns a fixed value matchUnitField :: t0 -> t1 -> (t0, (t2 -> Either t3 t1)) @@ -247,10 +249,10 @@ let showAll = False ellipsis = - \strings -> Logic.ifElse (Logic.and (Equality.gt (Lists.length strings) 3) (Logic.not showAll)) (Lists.concat2 (Lists.take 3 strings) [ + \strings -> Logic.ifElse (Logic.and (Ordering.gt (Lists.length strings) 3) (Logic.not showAll)) (Lists.concat2 (Lists.take 3 strings) [ "..."]) strings errMsg = - Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 "no such element: " (Core.unName name)) ". Available elements: {") (Strings.intercalate ", " (ellipsis (Lists.map Core.unName (Maps.keys (Graph.graphBoundTerms graph)))))) "}" + Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "no such element: " (Core.unName name)) ". Available elements: {") (Strings.join ", " (ellipsis (Lists.map Core.unName (Maps.keys (Graph.graphBoundTerms graph)))))) "}" in (Optionals.cases (lookupBinding graph name) (Left (Errors.ErrorResolution (Errors.ResolutionErrorOther (Errors.OtherResolutionError errMsg)))) (\x -> Right x)) -- | Look up a primitive in a graph by name, failing if it is not registered diff --git a/src/main/haskell/Hydra/Lib/Chars.hs b/src/main/haskell/Hydra/Lib/Chars.hs --- a/src/main/haskell/Hydra/Lib/Chars.hs +++ b/src/main/haskell/Hydra/Lib/Chars.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -35,6 +36,34 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +isAlpha :: Packaging.PrimitiveDefinition +isAlpha = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.chars.isAlpha"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether a character is alphabetic."), + Packaging.entityMetadataComments = [ + "True if the argument is a Unicode letter \8212 any of the general categories L* (Lu, Ll, Lt, Lm, Lo) \8212 and false otherwise.", + "The argument is interpreted as a Unicode code point: arguments outside the valid code-point range [0, 0x10FFFF] yield an implementation-defined result (typically false).", + "Alphabetic is broader than cased: letters in scripts without a case distinction are included. isAlphaNum is true whenever isAlpha is true.", + "Total. Corresponds to Haskell's Data.Char.isAlpha :: Char -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + isAlphaNum :: Packaging.PrimitiveDefinition isAlphaNum = Packaging.PrimitiveDefinition { @@ -52,8 +81,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -63,6 +92,33 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +isDigit :: Packaging.PrimitiveDefinition +isDigit = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.chars.isDigit"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether a character is an ASCII decimal digit."), + Packaging.entityMetadataComments = [ + "True if the argument is one of the ten code points '0' through '9' (U+0030 to U+0039), and false otherwise.", + "Unlike the other predicates in this module, this one is deliberately ASCII-only: decimal digits outside the ASCII range (general category Nd) are rejected here, though isAlphaNum accepts them.", + "Total. Corresponds to Haskell's Data.Char.isDigit :: Char -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + isLower :: Packaging.PrimitiveDefinition isLower = Packaging.PrimitiveDefinition { @@ -80,8 +136,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -107,8 +163,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -135,8 +191,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to test, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -163,8 +219,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to convert, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -191,8 +247,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "char"), + Typing.parameterDescription = (Just "the character to convert, as a Unicode code point"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Defaults.hs b/src/main/haskell/Hydra/Lib/Defaults.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Defaults.hs @@ -0,0 +1,1454 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A module which provides a single map from primitive names to their default, cross-compilable reference implementations, for primitives which declare one. + +module Hydra.Lib.Defaults where + +import qualified Hydra.Core as Core +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | A map from primitive name to default (cross-compilable) reference implementation, for primitives which declare one. Each value is an encoded (reified) term; decode it to recover the executable implementation. +defaultImplementations :: M.Map Core.Name Core.Term +defaultImplementations = + M.fromList [ + ( + Core.Name "hydra.lib.eithers.apply", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ef"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ex"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "ef"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ex"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.bimap", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Left (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Right (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "g")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.bind", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Left (Core.TermVariable (Core.Name "x"))))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))), + ( + Core.Name "hydra.lib.eithers.compose", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.foldList", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc0"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "el"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "a"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermEither (Right (Core.TermVariable (Core.Name "acc0"))))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.isLeft", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean True))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))), + ( + Core.Name "hydra.lib.eithers.isRight", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean True))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))), + ( + Core.Name "hydra.lib.eithers.lefts", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "l"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "l"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))), + ( + Core.Name "hydra.lib.eithers.map", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Left (Core.TermVariable (Core.Name "x"))))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Right (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))), + ( + Core.Name "hydra.lib.eithers.mapList", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermEither (Right (Core.TermList [])))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.eithers.mapOptional", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermEither (Right (Core.TermOptional Nothing)))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermOptional (Just (Core.TermVariable (Core.Name "y"))))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.mapSet", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermEither (Right (Core.TermList [])))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.eithers.partition", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "l"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "l"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "r"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "r"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))})), + Core.applicationArgument = (Core.TermPair (Core.TermList [], (Core.TermList [])))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))), + ( + Core.Name "hydra.lib.eithers.pure", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Right (Core.TermVariable (Core.Name "x"))))}))), + ( + Core.Name "hydra.lib.eithers.rights", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "e"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "r"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "r"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))), + ( + Core.Name "hydra.lib.equality.notEqual", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.not")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))}))}))), + ( + Core.Name "hydra.lib.lists.bind", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.lists.dropWhile", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.span")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))}))), + ( + Core.Name "hydra.lib.lists.filter", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.lists.find", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermOptional (Just (Core.TermVariable (Core.Name "x"))))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationArgument = (Core.TermOptional Nothing)})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.lists.partition", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))))})), + Core.applicationArgument = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))))}))}))}))})), + Core.applicationArgument = (Core.TermPair (Core.TermList [], (Core.TermList [])))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.lists.span", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.and")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.null")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})), + Core.applicationArgument = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermList [ + Core.TermVariable (Core.Name "x")])}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))))})), + Core.applicationArgument = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermList [ + Core.TermVariable (Core.Name "x")])}))))}))}))}))})), + Core.applicationArgument = (Core.TermPair (Core.TermList [], (Core.TermList [])))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.lists.takeWhile", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.span")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))}))), + ( + Core.Name "hydra.lib.logic.and", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "a"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "b"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))}))}))), + ( + Core.Name "hydra.lib.logic.not", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "a"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))}))), + ( + Core.Name "hydra.lib.logic.or", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "a"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "b"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "b"))}))}))}))), + ( + Core.Name "hydra.lib.maps.alter", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "k"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.lookup")), + Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.delete")), + Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "vNew"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.insert")), + Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "vNew"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.bimap", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "fk"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "fv"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "fk")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "fv")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}))))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.filter", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.filter")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "pr"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "pr"))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.filterWithKey", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.filter")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "pr"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "pr"))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "pr"))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.findWithDefault", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "def"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "k"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")), + Core.applicationArgument = (Core.TermVariable (Core.Name "def"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.lookup")), + Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.map", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}))))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.maps.mapKeys", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.math.even", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mod")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))}))}))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))), + ( + Core.Name "hydra.lib.math.odd", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.not")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.even")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))), + ( + Core.Name "hydra.lib.optionals.apply", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "mf"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "mx"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "mf"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "mx"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.bind", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermOptional Nothing)})), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))}))), + ( + Core.Name "hydra.lib.optionals.compose", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.foldList", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.givens", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "v"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))), + ( + Core.Name "hydra.lib.optionals.isGiven", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean True))}))}))}))), + ( + Core.Name "hydra.lib.optionals.isNone", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "_"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))}))}))}))), + ( + Core.Name "hydra.lib.optionals.map", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermOptional Nothing)})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermOptional (Just (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.mapList", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermList [])}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))), + ( + Core.Name "hydra.lib.optionals.mapOptional", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.givens")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.mapSet", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermList [])}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.optionals.pure", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermOptional (Just (Core.TermVariable (Core.Name "x"))))}))), + ( + Core.Name "hydra.lib.optionals.toList", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermList [ + Core.TermVariable (Core.Name "x")])}))}))}))), + ( + Core.Name "hydra.lib.optionals.withDefault", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "def"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "def"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))}))}))}))), + ( + Core.Name "hydra.lib.pairs.bimap", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermPair ( + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}), + (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "g")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}))))}))}))}))), + ( + Core.Name "hydra.lib.sets.difference", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s1"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s2"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "el"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.member")), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "s2"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.insert")), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "hydra.lib.sets.empty"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s1"))}))}))}))}))), + ( + Core.Name "hydra.lib.sets.filter", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.filter")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.sets.intersection", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s1"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s2"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "el"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.member")), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "s2"))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.insert")), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "hydra.lib.sets.empty"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s1"))}))}))}))}))), + ( + Core.Name "hydra.lib.sets.map", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))}))), + ( + Core.Name "hydra.lib.sets.union", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s1"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s2"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "el"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.insert")), + Core.applicationArgument = (Core.TermVariable (Core.Name "el"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "s2"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s1"))}))}))}))}))), + ( + Core.Name "hydra.lib.sets.unions", + (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ss"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.union")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "hydra.lib.sets.empty"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ss"))}))})))] diff --git a/src/main/haskell/Hydra/Lib/Effects.hs b/src/main/haskell/Hydra/Lib/Effects.hs --- a/src/main/haskell/Hydra/Lib/Effects.hs +++ b/src/main/haskell/Hydra/Lib/Effects.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -55,15 +56,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ef"), + Typing.parameterDescription = (Just "the effect producing the function to apply"), Typing.parameterType = (Core.TypeEffect (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))}))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ex"), + Typing.parameterDescription = (Just "the effect producing the argument"), Typing.parameterType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -94,13 +95,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the effect to interpret first"), Typing.parameterType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function producing the next effect from e's result"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))})), @@ -135,22 +136,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the first effect-returning function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the second effect-returning function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "z")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the input to the composed computation"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -160,14 +161,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -foldl :: Packaging.PrimitiveDefinition -foldl = +foldList :: Packaging.PrimitiveDefinition +foldList = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.foldl"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.foldList"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Left-fold over a list with an effect-returning function."), Packaging.entityMetadataComments = [ - "foldl(f, acc0, xs) describes an effectful left fold over xs, sequencing applications of f from left to right."], + "foldList(f, acc0, xs) describes an effectful left fold over xs, sequencing applications of f from left to right."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -180,8 +181,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the effect-returning combining function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -189,13 +190,13 @@ Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "x")))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "acc0"), + Typing.parameterDescription = (Just "the initial accumulator value"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -226,15 +227,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the pure function to apply to the effect's result"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the effect to interpret"), Typing.parameterType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -264,15 +265,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the effect-returning function to apply to each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to map over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -302,15 +303,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the effect-returning function to apply to the contained value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to map over"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -320,6 +321,47 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +mapSet :: Packaging.PrimitiveDefinition +mapSet = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.mapSet"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Map an effect-returning function over a set."), + Packaging.entityMetadataComments = [ + "mapSet(f, s) describes an effectful computation which applies f to each element of s, sequencing the effects in ascending element order (the order is normative, since the effects are observable), and collects the results as a set, deduplicated by the result type's ordering.", + "Requires 'ordering' constraints on both element types (the set type contract)."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the effect-returning function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to map over"), + Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeSet (Core.TypeVariable (Core.Name "y"))))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + pure :: Packaging.PrimitiveDefinition pure = Packaging.PrimitiveDefinition { @@ -337,8 +379,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the pure value to lift into an effect"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Eithers.hs b/src/main/haskell/Hydra/Lib/Eithers.hs --- a/src/main/haskell/Hydra/Lib/Eithers.hs +++ b/src/main/haskell/Hydra/Lib/Eithers.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -35,6 +36,73 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +apply :: Packaging.PrimitiveDefinition +apply = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.apply"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Applicative apply for either: combine a function under either and an argument under either."), + Packaging.entityMetadataComments = [ + "apply(ef, ex) returns right(f(x)) when ef is right(f) and ex is right(x).", + "If either argument is a left, the result is that left; when both arguments are left, the first (function-side) left is returned \8212 first error wins, and ex is not consulted once ef is known to be a left.", + "apply(ef, ex) is bind(ef, \\f -> map(f, ex)); this defining equation is the specification, and the default implementation.", + "Total. Corresponds to Haskell's (<*>) :: Either a (b -> c) -> Either a b -> Either a c."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "z"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "ef"), + Typing.parameterDescription = (Just "the either containing the function to apply"), + Typing.parameterType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), + Core.eitherTypeRight = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "z"))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "ex"), + Typing.parameterDescription = (Just "the either containing the argument"), + Typing.parameterType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "z"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ef"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ex"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "ef"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.map")), + Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ex"))}))}))}))}))})))} + bimap :: Packaging.PrimitiveDefinition bimap = Packaging.PrimitiveDefinition { @@ -62,22 +130,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to a Left value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "z"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the function to apply to a Right value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "w"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to map over"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), @@ -141,15 +209,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to bind"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to a Right value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { @@ -180,6 +248,80 @@ Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))})))} +compose :: Packaging.PrimitiveDefinition +compose = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.compose"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Kleisli composition for either."), + Packaging.entityMetadataComments = [ + "compose(f, g, x) is bind(f(x), g); this defining equation is the specification, and the default implementation.", + "If either f(x) or the second stage produces a left, the result is that left.", + "Total. Corresponds to Kleisli composition (>=>) specialised to Either with a fixed Left type."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "z"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "w"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the first Kleisli arrow to apply"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "w")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the second Kleisli arrow to apply"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "w")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "z"))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the input value"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "w")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "z"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))}))}))})))} + either :: Packaging.PrimitiveDefinition either = Packaging.PrimitiveDefinition { @@ -205,22 +347,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to a Left value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "z"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the function to apply to a Right value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "z"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to eliminate"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), @@ -232,15 +374,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -foldl :: Packaging.PrimitiveDefinition -foldl = +foldList :: Packaging.PrimitiveDefinition +foldList = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.foldl"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.foldList"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Left-fold over a list with an Either-returning function, short-circuiting on Left."), Packaging.entityMetadataComments = [ - "foldl(f, acc0, xs) folds f over xs from the left, threading an accumulator of type a, where each application may fail with Left e: foldl iterates while f returns Right, propagates Left on the first failure, and returns Right (final accumulator) if all elements were processed. Equivalent to chaining bind over the list.", - "Total in the sense that it terminates on finite inputs; the result is a Left whenever any application of f returns one.", + "foldList(f, acc0, xs) folds f over xs from the left, threading an accumulator of type a, where each application may fail with Left e: it iterates while f returns Right, propagates Left on the first failure, and returns Right (final accumulator) if all elements were processed.", "Corresponds to a short-circuiting variant of Haskell's foldM specialised to Either."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -257,8 +398,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the Either-returning folding function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -268,13 +409,13 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "x"))}))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "acc0"), + Typing.parameterDescription = (Just "the initial accumulator value"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -318,120 +459,6 @@ Core.applicationArgument = (Core.TermEither (Right (Core.TermVariable (Core.Name "acc0"))))})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))})))} -fromLeft :: Packaging.PrimitiveDefinition -fromLeft = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.fromLeft"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Extract the Left value, or return a default."), - Packaging.entityMetadataComments = [ - "fromLeft(def, e) returns the contained Left value if e is a Left, or def if e is a Right.", - "Total. Corresponds to Haskell's Data.Either.fromLeft :: a -> Either a b -> a."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}, - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "y"), - Typing.typeParameterConstraints = []}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = True}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeEither (Core.EitherType { - Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), - Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))})), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "def"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))})))} - -fromRight :: Packaging.PrimitiveDefinition -fromRight = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.fromRight"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Extract the Right value, or return a default."), - Packaging.entityMetadataComments = [ - "fromRight(def, e) returns the contained Right value if e is a Right, or def if e is a Left.", - "Total. Corresponds to Haskell's Data.Either.fromRight :: b -> Either a b -> b."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}, - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "y"), - Typing.typeParameterConstraints = []}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "y")), - Typing.parameterIsLazy = True}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeEither (Core.EitherType { - Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), - Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "y"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "def"))}))})), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))})))} - isLeft :: Packaging.PrimitiveDefinition isLeft = Packaging.PrimitiveDefinition { @@ -453,8 +480,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to test"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), @@ -502,8 +529,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to test"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))})), @@ -551,8 +578,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of either values to extract Lefts from"), Typing.parameterType = (Core.TypeList (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))), @@ -620,15 +647,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to a Right value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "e"), + Typing.parameterDescription = (Just "the either value to map over"), Typing.parameterType = (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "z")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "x"))})), @@ -686,8 +713,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the either-returning function to apply to each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { @@ -695,8 +722,8 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to map over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -770,8 +797,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the either-returning function to apply to the contained value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { @@ -779,8 +806,8 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to map over"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -840,8 +867,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the either-returning function to apply to each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { @@ -849,8 +876,8 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to map over"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -911,14 +938,14 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))})))} -partitionEithers :: Packaging.PrimitiveDefinition -partitionEithers = +partition :: Packaging.PrimitiveDefinition +partition = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.partitionEithers"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.partition"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Partition a list of either values into lefts and rights."), Packaging.entityMetadataComments = [ - "partitionEithers(xs) returns a pair (lefts, rights) where lefts contains every Left value from xs in original order and rights contains every Right value from xs in original order.", + "partition(xs) returns a pair (lefts, rights) where lefts contains every Left value from xs in original order and rights contains every Right value from xs in original order.", "Total. Corresponds to Haskell's Data.Either.partitionEithers :: [Either a b] -> ([a], [b])."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -932,8 +959,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of either values to partition"), Typing.parameterType = (Core.TypeList (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))), @@ -994,6 +1021,44 @@ Core.applicationArgument = (Core.TermPair (Core.TermList [], (Core.TermList [])))})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))})))} +pure :: Packaging.PrimitiveDefinition +pure = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.eithers.pure"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Wrap a value as a right."), + Packaging.entityMetadataComments = [ + "pure(x) is right(x); this defining equation is the specification, and the default implementation.", + "This is the unit of the either monad; it exists so that code written generically over a monad can reach the unit.", + "Total. Corresponds to Haskell's pure / Right for Either."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to wrap as a Right"), + Typing.parameterType = (Core.TypeVariable (Core.Name "y")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermEither (Right (Core.TermVariable (Core.Name "x"))))})))} + rights :: Packaging.PrimitiveDefinition rights = Packaging.PrimitiveDefinition { @@ -1015,8 +1080,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of either values to extract Rights from"), Typing.parameterType = (Core.TypeList (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "x")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))), diff --git a/src/main/haskell/Hydra/Lib/Equality.hs b/src/main/haskell/Hydra/Lib/Equality.hs --- a/src/main/haskell/Hydra/Lib/Equality.hs +++ b/src/main/haskell/Hydra/Lib/Equality.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -35,43 +36,6 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci -compare :: Packaging.PrimitiveDefinition -compare = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.compare"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Compare two values and return a Comparison."), - Packaging.entityMetadataComments = [ - "compare(x, y) returns the hydra.util.Comparison value that classifies the relationship between x and y under the type's ordering: LessThan if x < y, EqualTo if x == y, GreaterThan if x > y.", - "The result type's three-valued tag is the canonical primitive comparison; the boolean comparators (lt/lte/gt/gte) and equal are derivable from it.", - "Requires an 'ordering' type-class constraint on the argument type, which is the closest Hydra equivalent to Haskell's Ord instance.", - "Total. Corresponds to Haskell's compare :: Ord a => a -> a -> Ordering."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "hydra.util.Comparison"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - equal :: Packaging.PrimitiveDefinition equal = Packaging.PrimitiveDefinition { @@ -93,49 +57,13 @@ Core.TypeClassConstraintSimple (Core.Name "equality")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -gt :: Packaging.PrimitiveDefinition -gt = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.gt"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Check whether the first value is greater than the second."), - Packaging.entityMetadataComments = [ - "gt(x, y) returns true iff x > y under the type's ordering.", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's (>) :: Ord a => a -> a -> Bool."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -145,16 +73,16 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -gte :: Packaging.PrimitiveDefinition -gte = +notEqual :: Packaging.PrimitiveDefinition +notEqual = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.gte"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.notEqual"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Check whether the first value is greater than or equal to the second."), + Packaging.entityMetadataDescription = (Just "Check whether two values are unequal."), Packaging.entityMetadataComments = [ - "gte(x, y) returns true iff x >= y under the type's ordering.", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's (>=) :: Ord a => a -> a -> Bool."], + "notEqual(x, y) = logic.not(equal(x, y)); this defining equation is the specification, and the default implementation.", + "Requires an 'equality' type-class constraint on the argument type.", + "Total. Corresponds to Haskell's (/=) :: Eq a => a -> a -> Bool."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -162,16 +90,16 @@ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Core.TypeClassConstraintSimple (Core.Name "equality")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -179,212 +107,16 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -identity :: Packaging.PrimitiveDefinition -identity = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.identity"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return a value unchanged."), - Packaging.entityMetadataComments = [ - "identity(x) = x. The polymorphic identity function.", - "Total. Corresponds to Haskell's id :: a -> a."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))} - -lt :: Packaging.PrimitiveDefinition -lt = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.lt"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Check whether the first value is less than the second."), - Packaging.entityMetadataComments = [ - "lt(x, y) returns true iff x < y under the type's ordering.", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's (<) :: Ord a => a -> a -> Bool."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -lte :: Packaging.PrimitiveDefinition -lte = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.lte"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Check whether the first value is less than or equal to the second."), - Packaging.entityMetadataComments = [ - "lte(x, y) returns true iff x <= y under the type's ordering.", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's (<=) :: Ord a => a -> a -> Bool."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -max :: Packaging.PrimitiveDefinition -max = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.max"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the maximum of two values."), - Packaging.entityMetadataComments = [ - "max(x, y) returns the larger of x and y under the type's ordering; if x == y, it returns y (matching Haskell's convention).", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's max :: Ord a => a -> a -> a."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { Core.lambdaParameter = (Core.Name "y"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), - Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.gte")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))} - -min :: Packaging.PrimitiveDefinition -min = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.equality.min"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the minimum of two values."), - Packaging.entityMetadataComments = [ - "min(x, y) returns the smaller of x and y under the type's ordering; if x == y, it returns x (matching Haskell's convention).", - "Requires an 'ordering' constraint on the argument type.", - "Total. Corresponds to Haskell's min :: Ord a => a -> a -> a."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "ordering")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "y"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.not")), + Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), - Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.lte")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))}))})))} diff --git a/src/main/haskell/Hydra/Lib/Files.hs b/src/main/haskell/Hydra/Lib/Files.hs --- a/src/main/haskell/Hydra/Lib/Files.hs +++ b/src/main/haskell/Hydra/Lib/Files.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -49,13 +50,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the file to append to"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "contents"), + Typing.parameterDescription = (Just "the raw bytes to append"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -81,18 +82,18 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "recursive"), + Typing.parameterDescription = (Just "whether to copy a directory tree rather than a single file"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "source"), + Typing.parameterDescription = (Just "the path to copy from"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "destination"), + Typing.parameterDescription = (Just "the path to copy to"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -118,13 +119,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "recursive"), + Typing.parameterDescription = (Just "whether to create missing parent directories as well"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the directory to create"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -150,8 +151,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path to test for existence"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -177,8 +178,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the directory to list"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -204,8 +205,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the file to read"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -231,13 +232,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "recursive"), + Typing.parameterDescription = (Just "whether to remove the directory's contents as well"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the directory to remove"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -263,8 +264,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the file to remove"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -290,13 +291,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "source"), + Typing.parameterDescription = (Just "the path to rename from"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "destination"), + Typing.parameterDescription = (Just "the path to rename to"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -322,8 +323,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path to retrieve metadata for"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -349,13 +350,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "path"), + Typing.parameterDescription = (Just "the path of the file to write"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "contents"), + Typing.parameterDescription = (Just "the raw bytes to write as the file's contents"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Functions.hs b/src/main/haskell/Hydra/Lib/Functions.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Functions.hs @@ -0,0 +1,240 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.functions module. + +module Hydra.Lib.Functions where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +compose :: Packaging.PrimitiveDefinition +compose = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.functions.compose"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compose two functions."), + Packaging.entityMetadataComments = [ + "compose(g, f, x) = g(f(x)); this defining equation is the specification.", + "The outer function comes first: f is applied to x, and g is applied to the result.", + "This is ordinary function composition, distinct from the Kleisli compose primitives of the monad modules.", + "Total. Corresponds to Haskell's (.) :: (b -> c) -> (a -> b) -> a -> c."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t1"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t2"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t3"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the outer function, applied to the result of f"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t3"))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the inner function, applied to x first"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t2"))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the argument to which f is applied"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t1")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "t3"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "g"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "g")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))}))})))} + +const :: Packaging.PrimitiveDefinition +const = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.functions.const"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the first argument, ignoring the second."), + Packaging.entityMetadataComments = [ + "const(x, y) = x; this defining equation is the specification.", + "Partially applied, const(x) is the constant function which returns x on every input.", + "Total. Corresponds to Haskell's const :: a -> b -> a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t1"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t2"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to return"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t1")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the ignored second argument"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t2")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "t1"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))})))} + +flip :: Packaging.PrimitiveDefinition +flip = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.functions.flip"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Swap the argument order of a binary function."), + Packaging.entityMetadataComments = [ + "flip(f, x, y) = f(y, x); this defining equation is the specification.", + "Total. Corresponds to Haskell's flip :: (a -> b -> c) -> b -> a -> c."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t1"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t2"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t3"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the binary function whose argument order is swapped"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t3"))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the argument passed as f's second argument"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t2")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the argument passed as f's first argument"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t1")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "t3"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))})))} + +identity :: Packaging.PrimitiveDefinition +identity = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.functions.identity"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the argument unchanged."), + Packaging.entityMetadataComments = [ + "identity(x) = x; this defining equation is the specification. The polymorphic identity function.", + "identity is the unit of compose: compose(identity, f) and compose(f, identity) are both f.", + "Total. Corresponds to Haskell's id :: a -> a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "t1"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to return unchanged"), + Typing.parameterType = (Core.TypeVariable (Core.Name "t1")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "t1"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))} diff --git a/src/main/haskell/Hydra/Lib/Hashing.hs b/src/main/haskell/Hydra/Lib/Hashing.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Hashing.hs @@ -0,0 +1,89 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.hashing module. + +module Hydra.Lib.Hashing where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +sha256 :: Packaging.PrimitiveDefinition +sha256 = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.hashing.sha256"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compute the SHA-256 digest of a sequence of bytes."), + Packaging.entityMetadataComments = [ + "sha256(bytes) returns the 32-byte SHA-256 digest of bytes. Total: hashing is pure and never fails.", + "Pairs with hydra.lib.files.readFile, which returns raw bytes, to hash file contents."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "bytes"), + Typing.parameterDescription = (Just "the sequence of bytes to hash"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBinary)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +sha256Hex :: Packaging.PrimitiveDefinition +sha256Hex = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.hashing.sha256Hex"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compute the SHA-256 digest of a sequence of bytes as a lowercase hex string."), + Packaging.entityMetadataComments = [ + "sha256Hex(bytes) returns the SHA-256 digest of bytes as a 64-character lowercase hexadecimal string. Equivalent to hex-encoding the output of sha256. Total: hashing is pure and never fails.", + "Pairs with hydra.lib.files.readFile, which returns raw bytes, to hash file contents."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "bytes"), + Typing.parameterDescription = (Just "the sequence of bytes to hash"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} diff --git a/src/main/haskell/Hydra/Lib/Lists.hs b/src/main/haskell/Hydra/Lib/Lists.hs --- a/src/main/haskell/Hydra/Lib/Lists.hs +++ b/src/main/haskell/Hydra/Lib/Lists.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -57,15 +58,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "fs"), + Typing.parameterDescription = (Just "the list of functions to apply"), Typing.parameterType = (Core.TypeList (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))}))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of values to apply them to"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -75,6 +76,40 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +at :: Packaging.PrimitiveDefinition +at = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.at"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the element at the given index, or Nothing if out of bounds."), + Packaging.entityMetadataComments = [ + "at(i, xs) returns Just(xs[i]) if 0 <= i < length(xs), or Nothing otherwise.", + "Total. Wraps the Haskell (!!) operator, which is partial, in maybe to make out-of-bounds total."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "i"), + Typing.parameterDescription = (Just "the index to look up"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to index into"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bind :: Packaging.PrimitiveDefinition bind = Packaging.PrimitiveDefinition { @@ -96,13 +131,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to bind over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function returning a list for each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "y")))})), @@ -138,6 +173,55 @@ Core.applicationArgument = (Core.TermList [])})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))})))} +compose :: Packaging.PrimitiveDefinition +compose = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.compose"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compose two functions that return lists (Kleisli composition in the list monad)."), + Packaging.entityMetadataComments = [ + "compose(f, g, x) is bind(f(x), g); this defining equation is the specification. The results of applying g to each element of f(x) are concatenated in order.", + "Total. Corresponds to Kleisli composition (>=>) in the list monad."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "z"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the first list-returning function"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the second list-returning function"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "z")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the input value"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "z")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + concat :: Packaging.PrimitiveDefinition concat = Packaging.PrimitiveDefinition { @@ -156,8 +240,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xss"), + Typing.parameterDescription = (Just "the list of lists to concatenate"), Typing.parameterType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "x")))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -185,13 +269,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the first list"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ys"), + Typing.parameterDescription = (Just "the list to append"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -219,13 +303,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to prepend"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to prepend to"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -235,6 +319,37 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +distinct :: Packaging.PrimitiveDefinition +distinct = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.distinct"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Remove duplicate elements from a list."), + Packaging.entityMetadataComments = [ + "distinct(xs) returns the list of distinct elements of xs, in the order of their first occurrence.", + "Requires an 'equality' constraint on the element type.", + "Total. Corresponds to Haskell's Data.List.nub :: Eq a => [a] -> [a]."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "equality")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to deduplicate"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + drop :: Packaging.PrimitiveDefinition drop = Packaging.PrimitiveDefinition { @@ -253,13 +368,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "n"), + Typing.parameterDescription = (Just "the number of elements to drop"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to drop from"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -287,15 +402,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to drop from"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -317,42 +432,6 @@ Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))})))} -elem :: Packaging.PrimitiveDefinition -elem = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.elem"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Test whether an element is in a list."), - Packaging.entityMetadataComments = [ - "elem(x, xs) returns true iff some element of xs is equal to x.", - "Requires an 'equality' constraint on the element type.", - "Total. Corresponds to Haskell's elem :: Eq a => a -> [a] -> Bool."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = [ - Core.TypeClassConstraintSimple (Core.Name "equality")]}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - filter :: Packaging.PrimitiveDefinition filter = Packaging.PrimitiveDefinition { @@ -371,15 +450,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to filter"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -437,15 +516,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to search"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -481,6 +560,53 @@ Core.applicationArgument = (Core.TermOptional Nothing)})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))})))} +foldList :: Packaging.PrimitiveDefinition +foldList = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.foldList"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Left-fold a list in the list monad (a nondeterministic fold)."), + Packaging.entityMetadataComments = [ + "foldList(f, acc0, xs) folds xs from the left, branching the accumulator over every result of the step function at each element: after each element the set of accumulators is replaced by all results of applying f to each current accumulator and that element.", + "foldList(f, acc0, xs) is foldl(\\macc el -> bind(macc, \\acc -> f(acc, el)), pure(acc0), xs); this defining equation is the specification. For the empty list the result is pure(acc0).", + "Total on finite inputs. The list-monad instance of the monadic left fold."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the branching step function"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "acc0"), + Typing.parameterDescription = (Just "the initial accumulator"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + foldl :: Packaging.PrimitiveDefinition foldl = Packaging.PrimitiveDefinition { @@ -503,8 +629,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the step function combining accumulator and element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -512,13 +638,13 @@ Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "acc0"), + Typing.parameterDescription = (Just "the initial accumulator"), Typing.parameterType = (Core.TypeVariable (Core.Name "y")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -549,8 +675,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the step function combining element and accumulator"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -558,13 +684,13 @@ Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "acc0"), + Typing.parameterDescription = (Just "the initial accumulator"), Typing.parameterType = (Core.TypeVariable (Core.Name "y")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -594,8 +720,8 @@ Core.TypeClassConstraintSimple (Core.Name "equality")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to group"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -605,15 +731,15 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -intercalate :: Packaging.PrimitiveDefinition -intercalate = +head :: Packaging.PrimitiveDefinition +head = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.intercalate"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.head"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Intercalate a list of lists with a separator list between each."), + Packaging.entityMetadataDescription = (Just "Return the first element, or Nothing if the list is empty."), Packaging.entityMetadataComments = [ - "intercalate(sep, xss) returns the concatenation of xss with sep inserted between consecutive lists. Equivalent to concat(intersperse(sep, xss)).", - "Total. Corresponds to Haskell's intercalate :: [a] -> [[a]] -> [a]."], + "head(xs) returns Just(x) where x is the first element of xs, or Nothing if xs is empty.", + "Total. Wraps Haskell's partial head in maybe."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -623,18 +749,42 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take the head of"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), - Typing.parameterIsLazy = False}, + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +init :: Packaging.PrimitiveDefinition +init = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.init"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return all elements except the last, or Nothing if the list is empty."), + Packaging.entityMetadataComments = [ + "init(xs) returns Just(ys) where ys is xs with its last element removed, or Nothing if xs is empty.", + "Total. Wraps Haskell's partial init in maybe."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "x")))), + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take the initial segment of"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Typing.resultType = (Core.TypeOptional (Core.TypeList (Core.TypeVariable (Core.Name "x"))))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -657,13 +807,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "sep"), + Typing.parameterDescription = (Just "the separator value to insert"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to intersperse into"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -673,16 +823,15 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -length :: Packaging.PrimitiveDefinition -length = +join :: Packaging.PrimitiveDefinition +join = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.length"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.join"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the length of a list."), + Packaging.entityMetadataDescription = (Just "Intercalate a list of lists with a separator list between each."), Packaging.entityMetadataComments = [ - "length(xs) returns the number of elements in xs as an int32. Returns 0 for the empty list.", - "Total on finite inputs; the int32 result overflows for lists longer than 2^31-1 elements.", - "Corresponds to Haskell's length :: [a] -> Int (with narrowing to Int32)."], + "join(sep, xss) returns the concatenation of xss with sep inserted between consecutive lists. Equivalent to concat(intersperse(sep, xss)).", + "Total. Corresponds to Haskell's intercalate :: [a] -> [[a]] -> [a]."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -692,65 +841,61 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "sep"), + Typing.parameterDescription = (Just "the separator list to insert"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xss"), + Typing.parameterDescription = (Just "the list of lists to join"), + Typing.parameterType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "x")))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -map :: Packaging.PrimitiveDefinition -map = +last :: Packaging.PrimitiveDefinition +last = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.map"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.last"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Map a function over a list."), + Packaging.entityMetadataDescription = (Just "Return the last element, or Nothing if the list is empty."), Packaging.entityMetadataComments = [ - "map(f, xs) returns the list of f(x) for each x in xs, in original order.", - "Total. Corresponds to Haskell's map :: (a -> b) -> [a] -> [b] / fmap on lists."], + "last(xs) returns Just(x) where x is the last element of xs, or Nothing if xs is empty.", + "Total. Wraps Haskell's partial last in maybe."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}, - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "y"), Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeFunction (Core.FunctionType { - Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), - Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take the last element of"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}}, + Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeAt :: Packaging.PrimitiveDefinition -maybeAt = +length :: Packaging.PrimitiveDefinition +length = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.maybeAt"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.length"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the element at the given index, or Nothing if out of bounds."), + Packaging.entityMetadataDescription = (Just "Return the length of a list."), Packaging.entityMetadataComments = [ - "maybeAt(i, xs) returns Just(xs[i]) if 0 <= i < length(xs), or Nothing otherwise.", - "Total. Wraps the Haskell (!!) operator, which is partial, in maybe to make out-of-bounds total."], + "length(xs) returns the number of elements in xs as an int32. Returns 0 for the empty list.", + "Total on finite inputs; the int32 result overflows for lists longer than 2^31-1 elements.", + "Corresponds to Haskell's length :: [a] -> Int (with narrowing to Int32)."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -760,149 +905,187 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to measure"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, + Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeHead :: Packaging.PrimitiveDefinition -maybeHead = +map :: Packaging.PrimitiveDefinition +map = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.maybeHead"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.map"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the first element, or Nothing if the list is empty."), + Packaging.entityMetadataDescription = (Just "Map a function over a list."), Packaging.entityMetadataComments = [ - "maybeHead(xs) returns Just(x) where x is the first element of xs, or Nothing if xs is empty.", - "Total. Wraps Haskell's partial head in maybe."], + "map(f, xs) returns the list of f(x) for each x in xs, in original order.", + "Total. Corresponds to Haskell's map :: (a -> b) -> [a] -> [b] / fmap on lists."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to map over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeInit :: Packaging.PrimitiveDefinition -maybeInit = +mapList :: Packaging.PrimitiveDefinition +mapList = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.maybeInit"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.mapList"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return all elements except the last, or Nothing if the list is empty."), + Packaging.entityMetadataDescription = (Just "Traverse a list in the list monad."), Packaging.entityMetadataComments = [ - "maybeInit(xs) returns Just(ys) where ys is xs with its last element removed, or Nothing if xs is empty.", - "Total. Wraps Haskell's partial init in maybe."], + "mapList(f, xs) returns all combinations obtainable by choosing one element from f(x) for each x in xs: each result list has the same length as xs, with its element at each position drawn from the corresponding f(x).", + "Results appear in the lexicographic order of the choices, with the choice for the first element varying slowest. The number of results is the product of the lengths of the lists f(x); if f(x) is empty for any element, the result is the empty list; mapList(f, []) is pure([]).", + "Total on finite inputs. The list-monad instance of the traversal family."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the list-returning function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to traverse"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeList (Core.TypeVariable (Core.Name "x"))))}}, + Typing.resultType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "y"))))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeLast :: Packaging.PrimitiveDefinition -maybeLast = +mapOptional :: Packaging.PrimitiveDefinition +mapOptional = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.maybeLast"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.mapOptional"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the last element, or Nothing if the list is empty."), + Packaging.entityMetadataDescription = (Just "Traverse an optional value in the list monad."), Packaging.entityMetadataComments = [ - "maybeLast(xs) returns Just(x) where x is the last element of xs, or Nothing if xs is empty.", - "Total. Wraps Haskell's partial last in maybe."], + "mapOptional(f, m) returns the single-element list containing none when m is none; for given(x) it returns given(y) for each element y of f(x), in order.", + "Total on finite inputs. The list-monad instance of the traversal family, applied to the optional container."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the list-returning function to apply"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional value to traverse"), + Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, + Typing.resultType = (Core.TypeList (Core.TypeOptional (Core.TypeVariable (Core.Name "y"))))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeTail :: Packaging.PrimitiveDefinition -maybeTail = +mapSet :: Packaging.PrimitiveDefinition +mapSet = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.maybeTail"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.mapSet"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return all elements except the first, or Nothing if the list is empty."), + Packaging.entityMetadataDescription = (Just "Traverse a set in the list monad."), Packaging.entityMetadataComments = [ - "maybeTail(xs) returns Just(ys) where ys is xs with its first element removed, or Nothing if xs is empty.", - "Total. Wraps Haskell's partial tail in maybe."], + "mapSet(f, s) returns all sets obtainable by choosing one element from f(x) for each element x of s. Elements of s are traversed in ascending order, and results appear in the lexicographic order of the choices, with the choice for the least element varying slowest.", + "A result set may have fewer elements than s when distinct choices coincide. If f(x) is empty for any element, the result is the empty list; for the empty set the result is the single-element list containing the empty set.", + "Requires 'ordering' constraints on both element types (the set type contract)."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}], + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the list-returning function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to traverse"), + Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeList (Core.TypeVariable (Core.Name "x"))))}}, + Typing.resultType = (Core.TypeList (Core.TypeSet (Core.TypeVariable (Core.Name "y"))))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -nub :: Packaging.PrimitiveDefinition -nub = +member :: Packaging.PrimitiveDefinition +member = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.nub"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.member"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Remove duplicate elements from a list."), + Packaging.entityMetadataDescription = (Just "Test whether an element is in a list."), Packaging.entityMetadataComments = [ - "nub(xs) returns the list of distinct elements of xs, in the order of their first occurrence.", + "member(x, xs) returns true iff some element of xs is equal to x.", "Requires an 'equality' constraint on the element type.", - "Quadratic in the length of xs in the worst case.", - "Total. Corresponds to Haskell's Data.List.nub :: Eq a => [a] -> [a]."], + "Total. Corresponds to Haskell's elem :: Eq a => a -> [a] -> Bool."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { @@ -913,13 +1096,18 @@ Core.TypeClassConstraintSimple (Core.Name "equality")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to look for"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to search"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -942,8 +1130,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to test"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -971,15 +1159,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to partition"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1055,8 +1243,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to wrap"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1084,13 +1272,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "n"), + Typing.parameterDescription = (Just "the number of copies"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to replicate"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1118,8 +1306,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to reverse"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1147,8 +1335,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to wrap in a single-element list"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1178,8 +1366,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to sort"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1189,14 +1377,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -sortOn :: Packaging.PrimitiveDefinition -sortOn = +sortBy :: Packaging.PrimitiveDefinition +sortBy = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.sortOn"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.sortBy"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Sort a list using a key-extraction function."), Packaging.entityMetadataComments = [ - "sortOn(f, xs) returns xs sorted in ascending order by f(x) for each element x. Sort is stable: elements with equal keys preserve their original relative order.", + "sortBy(f, xs) returns xs sorted in ascending order by f(x) for each element x. Sort is stable: elements with equal keys preserve their original relative order.", "Requires an 'ordering' constraint on the key type.", "Total. Corresponds to Haskell's Data.List.sortOn :: Ord b => (a -> b) -> [a] -> [a]."], Packaging.entityMetadataSeeAlso = [], @@ -1212,15 +1400,15 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the key-extraction function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to sort"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1248,15 +1436,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to split"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1275,12 +1463,12 @@ Core.lambdaBody = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + Core.lambdaParameter = (Core.Name "acc"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { @@ -1290,36 +1478,69 @@ Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.and")), Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "p")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.null")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))})), Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.null")), - Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), - Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))})), + Core.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})), Core.applicationArgument = (Core.TermPair ( Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), - Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermList [ + Core.TermVariable (Core.Name "x")])}), (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))))})), Core.applicationArgument = (Core.TermPair ( - Core.TermList [], + Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}), (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), - Core.applicationArgument = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), - Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))))}))}))}))})), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat2")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermList [ + Core.TermVariable (Core.Name "x")])}))))}))}))}))})), Core.applicationArgument = (Core.TermPair (Core.TermList [], (Core.TermList [])))})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))})))} +tail :: Packaging.PrimitiveDefinition +tail = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.tail"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return all elements except the first, or Nothing if the list is empty."), + Packaging.entityMetadataComments = [ + "tail(xs) returns Just(ys) where ys is xs with its first element removed, or Nothing if xs is empty.", + "Total. Wraps Haskell's partial tail in maybe."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take the tail of"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeList (Core.TypeVariable (Core.Name "x"))))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + take :: Packaging.PrimitiveDefinition take = Packaging.PrimitiveDefinition { @@ -1338,13 +1559,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "n"), + Typing.parameterDescription = (Just "the number of elements to take"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take from"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1354,6 +1575,55 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +takeWhile :: Packaging.PrimitiveDefinition +takeWhile = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.lists.takeWhile"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Take elements from the beginning of a list while a predicate holds."), + Packaging.entityMetadataComments = [ + "takeWhile(p, xs) returns the longest prefix of xs whose elements all satisfy p. If p fails for the first element the result is the empty list; if p holds for every element the result is xs unchanged.", + "dropWhile returns the complementary suffix, and span(p, xs) returns the pair of takeWhile(p, xs) and dropWhile(p, xs).", + "Total. Corresponds to Haskell's takeWhile :: (a -> Bool) -> [a] -> [a]."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to take from"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.span")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))})))} + transpose :: Packaging.PrimitiveDefinition transpose = Packaging.PrimitiveDefinition { @@ -1372,8 +1642,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xss"), + Typing.parameterDescription = (Just "the list of lists to transpose"), Typing.parameterType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "x")))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1401,8 +1671,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to decompose"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1435,13 +1705,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the first list"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ys"), + Typing.parameterDescription = (Just "the second list"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1477,8 +1747,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the combining function"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -1486,13 +1756,13 @@ Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "z"))}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the first list"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ys"), + Typing.parameterDescription = (Just "the second list"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Literals.hs b/src/main/haskell/Hydra/Lib/Literals.hs --- a/src/main/haskell/Hydra/Lib/Literals.hs +++ b/src/main/haskell/Hydra/Lib/Literals.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -35,6 +36,32 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +base64ToBinary :: Packaging.PrimitiveDefinition +base64ToBinary = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.base64ToBinary"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Decode a base64 ASCII string to binary data."), + Packaging.entityMetadataComments = [ + "base64ToBinary(s) decodes the standard base64 (RFC 4648) ASCII string s and returns the resulting bytes as binary data.", + "Inverse of binaryToBase64: base64ToBinary(binaryToBase64(b)) is b for every binary value. Behavior on strings which are not valid base64 is host-defined."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the base64 string to decode"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBinary)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToDecimal :: Packaging.PrimitiveDefinition bigintToDecimal = Packaging.PrimitiveDefinition { @@ -50,8 +77,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -76,8 +103,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -102,8 +129,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -128,8 +155,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -154,8 +181,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -180,8 +207,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -206,8 +233,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -232,8 +259,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -258,8 +285,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -269,56 +296,55 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -binaryToBytes :: Packaging.PrimitiveDefinition -binaryToBytes = +binaryToBase64 :: Packaging.PrimitiveDefinition +binaryToBase64 = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.binaryToBytes"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.binaryToBase64"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Convert binary data to a list of byte values."), + Packaging.entityMetadataDescription = (Just "Encode binary data as a base64 ASCII string."), Packaging.entityMetadataComments = [ - "binaryToBytes(b) returns the bytes of b as an int32 list with values in [0, 255], preserving byte order.", - "The result list element type is int32 rather than uint8 because Hydra's primitive collections work most naturally with int32 indices.", - "Total."], + "binaryToBase64(b) encodes the bytes of b using standard base64 (RFC 4648) and returns the result as an ASCII string.", + "Total and round-trippable: base64ToBinary(binaryToBase64(b)) is b for every binary value. Use this to embed arbitrary binary data in a string context (e.g. a JSON value). For interpreting bytes as text, use hydra.lib.text.decodeUtf8 instead."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "b"), + Typing.parameterDescription = (Just "the binary data to encode"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -binaryToString :: Packaging.PrimitiveDefinition -binaryToString = +binaryToBytes :: Packaging.PrimitiveDefinition +binaryToBytes = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.binaryToString"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.binaryToBytes"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Convert binary data to a UTF-8 string."), + Packaging.entityMetadataDescription = (Just "Convert binary data to a list of byte values."), Packaging.entityMetadataComments = [ - "binaryToString(b) interprets the bytes of b as a UTF-8-encoded string and returns the decoded value.", - "The behavior on invalid UTF-8 byte sequences is host-defined: most hosts substitute the replacement character U+FFFD; some may signal an error or truncate.", - "Total in the sense that it does not raise from the kernel's perspective, but the result may carry the host's replacement semantics."], + "binaryToBytes(b) returns the bytes of b as an int32 list with values in [0, 255], preserving byte order.", + "The result list element type is int32 rather than uint8 because Hydra's primitive collections work most naturally with int32 indices.", + "Total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "b"), + Typing.parameterDescription = (Just "the binary data to convert"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, + Typing.resultType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -338,8 +364,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the decimal to convert"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeDecimal), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -364,8 +390,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the decimal to convert"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeDecimal), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -390,8 +416,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the decimal to convert"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeDecimal), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -416,8 +442,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float32 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -442,8 +468,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float32 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -468,8 +494,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float64 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -494,8 +520,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float64 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -520,8 +546,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int16 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt16)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -546,8 +572,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int32 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -572,8 +598,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int64 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -598,8 +624,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int8 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt8)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -609,15 +635,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -readBigint :: Packaging.PrimitiveDefinition -readBigint = +parseBoolean :: Packaging.PrimitiveDefinition +parseBoolean = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.readBigint"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.parseBoolean"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Parse a string as a bigint."), + Packaging.entityMetadataDescription = (Just "Parse a string as a boolean."), Packaging.entityMetadataComments = [ - "readBigint(s) returns Just(x) where x is the bigint parsed from s, or Nothing if s is not a valid bigint literal.", - "Accepted syntax follows the Haskell Show/Read convention: an optional leading minus sign followed by a sequence of decimal digits. Whitespace is not stripped; leading or trailing whitespace causes parse failure.", + "parseBoolean(s) returns Just(true) for \"true\", Just(false) for \"false\", and Nothing for any other input (including \"True\"/\"False\" with capital initial letter on some hosts; behavior on capitalized forms is host-defined and should not be relied upon).", "Total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -625,25 +650,104 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)))}}, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral Core.LiteralTypeBoolean))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -readBoolean :: Packaging.PrimitiveDefinition -readBoolean = +parseString :: Packaging.PrimitiveDefinition +parseString = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.readBoolean"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.parseString"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Parse a string as a boolean."), + Packaging.entityMetadataDescription = (Just "Parse a string-literal token to a plain string (Just) or Nothing on parse failure."), Packaging.entityMetadataComments = [ - "readBoolean(s) returns Just(true) for \"true\", Just(false) for \"false\", and Nothing for any other input (including \"True\"/\"False\" with capital initial letter on some hosts; behavior on capitalized forms is host-defined and should not be relied upon).", + "parseString(s) parses s as a Haskell-syntax string literal token: an opening double-quote, escaped characters per the Haskell lexical grammar (backslash escapes for special characters and Unicode code points), and a closing double-quote. Returns Just of the decoded payload on success or Nothing on malformed input.", + "Total. The inverse of printString."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string-literal token to parse"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral Core.LiteralTypeString))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +printBoolean :: Packaging.PrimitiveDefinition +printBoolean = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.printBoolean"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Render a boolean as a string."), + Packaging.entityMetadataComments = [ + "printBoolean(true) = \"true\"; printBoolean(false) = \"false\".", + "Total. The inverse of parseBoolean."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "b"), + Typing.parameterDescription = (Just "the boolean to render"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +printString :: Packaging.PrimitiveDefinition +printString = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.printString"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Render a string as a string-literal token (escaped and quoted)."), + Packaging.entityMetadataComments = [ + "printString(s) returns a Haskell-syntax string literal token representing s: an opening double-quote, the characters of s with special characters escaped (backslash sequences for control characters, quotes, and non-printable Unicode code points), and a closing double-quote.", + "Total. The inverse of parseString."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to render"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +readBigint :: Packaging.PrimitiveDefinition +readBigint = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.readBigint"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Parse a string as a bigint."), + Packaging.entityMetadataComments = [ + "readBigint(s) returns Just(x) where x is the bigint parsed from s, or Nothing if s is not a valid bigint literal.", + "Accepted syntax follows the Haskell Show/Read convention: an optional leading minus sign followed by a sequence of decimal digits. Whitespace is not stripped; leading or trailing whitespace causes parse failure.", "Total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -651,13 +755,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral Core.LiteralTypeBoolean))}}, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -678,8 +782,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -705,8 +809,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -732,8 +836,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -758,8 +862,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -784,8 +888,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -810,8 +914,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -836,8 +940,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -847,32 +951,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -readString :: Packaging.PrimitiveDefinition -readString = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.readString"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Parse a string-literal token to a plain string (Just) or Nothing on parse failure."), - Packaging.entityMetadataComments = [ - "readString(s) parses s as a Haskell-syntax string literal token: an opening double-quote, escaped characters per the Haskell lexical grammar (backslash escapes for special characters and Unicode code points), and a closing double-quote. Returns Just of the decoded payload on success or Nothing on malformed input.", - "Total. The inverse of showString."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral Core.LiteralTypeString))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - readUint16 :: Packaging.PrimitiveDefinition readUint16 = Packaging.PrimitiveDefinition { @@ -888,8 +966,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -914,8 +992,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -940,8 +1018,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -966,8 +1044,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to parse"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -992,8 +1070,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the bigint to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeBigint)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1003,32 +1081,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -showBoolean :: Packaging.PrimitiveDefinition -showBoolean = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.showBoolean"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Render a boolean as a string."), - Packaging.entityMetadataComments = [ - "showBoolean(true) = \"true\"; showBoolean(false) = \"false\".", - "Total. The inverse of readBoolean."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - showDecimal :: Packaging.PrimitiveDefinition showDecimal = Packaging.PrimitiveDefinition { @@ -1044,8 +1096,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the decimal to render"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeDecimal), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1070,8 +1122,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float32 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1096,8 +1148,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float64 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1122,8 +1174,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int16 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt16)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1148,8 +1200,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int32 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1174,8 +1226,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int64 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1200,8 +1252,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the int8 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt8)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1211,32 +1263,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -showString :: Packaging.PrimitiveDefinition -showString = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.showString"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Render a string as a string-literal token (escaped and quoted)."), - Packaging.entityMetadataComments = [ - "showString(s) returns a Haskell-syntax string literal token representing s: an opening double-quote, the characters of s with special characters escaped (backslash sequences for control characters, quotes, and non-printable Unicode code points), and a closing double-quote.", - "Total. The inverse of readString."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeString)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - showUint16 :: Packaging.PrimitiveDefinition showUint16 = Packaging.PrimitiveDefinition { @@ -1252,8 +1278,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint16 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint16)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1278,8 +1304,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint32 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1304,8 +1330,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint64 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1330,8 +1356,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint8 to render"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint8)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1341,32 +1367,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -stringToBinary :: Packaging.PrimitiveDefinition -stringToBinary = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.literals.stringToBinary"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Convert a UTF-8 string to binary data."), - Packaging.entityMetadataComments = [ - "stringToBinary(s) encodes s as a UTF-8 byte sequence and returns the result as binary data.", - "Total."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBinary)}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - uint16ToBigint :: Packaging.PrimitiveDefinition uint16ToBigint = Packaging.PrimitiveDefinition { @@ -1382,8 +1382,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint16 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint16)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1408,8 +1408,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint32 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1434,8 +1434,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint64 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1460,8 +1460,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the uint8 to convert"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint8)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Logic.hs b/src/main/haskell/Hydra/Lib/Logic.hs --- a/src/main/haskell/Hydra/Lib/Logic.hs +++ b/src/main/haskell/Hydra/Lib/Logic.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -51,13 +52,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the first boolean operand"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "q"), + Typing.parameterDescription = (Just "the second boolean operand"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -98,18 +99,18 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the boolean condition"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "t"), + Typing.parameterDescription = (Just "the value returned when p is true"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = True}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the value returned when p is false"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = True}], Typing.termSignatureResult = Typing.Result { @@ -134,8 +135,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the boolean value to negate"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -170,13 +171,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the first boolean operand"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "q"), + Typing.parameterDescription = (Just "the second boolean operand"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Maps.hs b/src/main/haskell/Hydra/Lib/Maps.hs --- a/src/main/haskell/Hydra/Lib/Maps.hs +++ b/src/main/haskell/Hydra/Lib/Maps.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -59,20 +60,20 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the update function, applied to the optional current value at the key"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "v"))), Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "v")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key whose binding to alter"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to update"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -151,22 +152,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "fk"), + Typing.parameterDescription = (Just "the function to apply to each key"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "k1")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "k2"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "fv"), + Typing.parameterDescription = (Just "the function to apply to each value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v1")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "v2"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to transform"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k1")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v1"))})), @@ -233,13 +234,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key to remove"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to remove the key from"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -253,6 +254,52 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +difference :: Packaging.PrimitiveDefinition +difference = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.maps.difference"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compute the difference of two maps by key."), + Packaging.entityMetadataComments = [ + "difference(m1, m2) returns the map containing exactly the bindings of m1 whose keys do not appear in m2. Only the key set of m2 matters; its values are ignored.", + "The key-set analogue is hydra.lib.sets.difference.", + "Requires an 'ordering' constraint on the key type.", + "Total. Corresponds to Haskell's Data.Map.difference :: Ord k => Map k v -> Map k v -> Map k v."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "k"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "v"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "m1"), + Typing.parameterDescription = (Just "the map whose bindings are retained"), + Typing.parameterType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "m2"), + Typing.parameterDescription = (Just "the map whose keys are subtracted"), + Typing.parameterType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + elems :: Packaging.PrimitiveDefinition elems = Packaging.PrimitiveDefinition { @@ -276,8 +323,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map whose values to return"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -343,15 +390,15 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v")), Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to filter"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -409,8 +456,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the predicate to test each key and value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "k")), Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { @@ -418,8 +465,8 @@ Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)}))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to filter"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -481,18 +528,18 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "def"), + Typing.parameterDescription = (Just "the default value, returned when the key is absent"), Typing.parameterType = (Core.TypeVariable (Core.Name "v")), Typing.parameterIsLazy = True}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key to look up"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to search"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -513,7 +560,7 @@ Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.fromOptional")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")), Core.applicationArgument = (Core.TermVariable (Core.Name "def"))})), Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { @@ -544,8 +591,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of key-value pairs to build the map from"), Typing.parameterType = (Core.TypeList (Core.TypePair (Core.PairType { Core.pairTypeFirst = (Core.TypeVariable (Core.Name "k")), Core.pairTypeSecond = (Core.TypeVariable (Core.Name "v"))}))), @@ -582,18 +629,18 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key to insert"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "v"), + Typing.parameterDescription = (Just "the value to bind to the key"), Typing.parameterType = (Core.TypeVariable (Core.Name "v")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to insert into"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -607,6 +654,52 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +intersection :: Packaging.PrimitiveDefinition +intersection = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.maps.intersection"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compute the intersection of two maps by key."), + Packaging.entityMetadataComments = [ + "intersection(m1, m2) returns the map containing exactly the bindings of m1 whose keys also appear in m2. On each common key the value is taken from m1; only the key set of m2 matters, and its values are ignored.", + "The key-set analogue is hydra.lib.sets.intersection.", + "Requires an 'ordering' constraint on the key type.", + "Total. Corresponds to Haskell's Data.Map.intersection :: Ord k => Map k v -> Map k v -> Map k v."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "k"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "v"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "m1"), + Typing.parameterDescription = (Just "the map whose bindings are retained"), + Typing.parameterType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "m2"), + Typing.parameterDescription = (Just "the map whose key set is intersected"), + Typing.parameterType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + keys :: Packaging.PrimitiveDefinition keys = Packaging.PrimitiveDefinition { @@ -630,8 +723,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map whose keys to return"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -666,13 +759,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key to look up"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to search"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -710,15 +803,15 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to each value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v1")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "v2"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to transform"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v1"))})), @@ -784,15 +877,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to each key"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "k1")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "k2"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to transform"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k1")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -854,13 +947,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key to test for"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to test"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -895,8 +988,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to test"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -931,13 +1024,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "k"), + Typing.parameterDescription = (Just "the key of the single binding"), Typing.parameterType = (Core.TypeVariable (Core.Name "k")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "v"), + Typing.parameterDescription = (Just "the value of the single binding"), Typing.parameterType = (Core.TypeVariable (Core.Name "v")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -972,8 +1065,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map whose bindings to count"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -1008,8 +1101,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the map to convert"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), @@ -1046,18 +1139,57 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m1"), + Typing.parameterDescription = (Just "the map whose bindings take precedence"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m2"), + Typing.parameterDescription = (Just "the map whose remaining bindings are added"), Typing.parameterType = (Core.TypeMap (Core.MapType { Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))})), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +unions :: Packaging.PrimitiveDefinition +unions = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.maps.unions"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compute the left-biased union of a list of maps."), + Packaging.entityMetadataComments = [ + "unions(ms) returns the map containing every binding of every map in ms; when a key occurs in more than one map, the binding from the earliest such map in the list wins.", + "unions(ms) is equivalent to folding union over ms from the left, starting from empty; unions([]) is empty, and the bias matches union and hydra.lib.sets.unions.", + "Requires an 'ordering' constraint on the key type.", + "Total. Corresponds to Haskell's Data.Map.unions :: Ord k => [Map k v] -> Map k v."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "k"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "v"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "ms"), + Typing.parameterDescription = (Just "the list of maps to combine"), + Typing.parameterType = (Core.TypeList (Core.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "k")), + Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, diff --git a/src/main/haskell/Hydra/Lib/Math.hs b/src/main/haskell/Hydra/Lib/Math.hs --- a/src/main/haskell/Hydra/Lib/Math.hs +++ b/src/main/haskell/Hydra/Lib/Math.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -51,8 +52,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the integer whose absolute value is taken"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -78,8 +79,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the cosine value whose arc cosine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -105,8 +106,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose inverse hyperbolic cosine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -121,28 +122,33 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.add"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Integer addition."), + Packaging.entityMetadataDescription = (Just "Numeric addition."), Packaging.entityMetadataComments = [ - "Two's-complement 32-bit signed integer addition. The result is x + y reduced modulo 2^32 and reinterpreted as a signed int32 (i.e. arithmetic wraps silently on overflow, with no exception raised).", - "The operation is total. Corresponds to Haskell's (+) :: Int32 -> Int32 -> Int32."], + "Constraint-polymorphic addition over any type with a 'numeric' instance. The per-type semantics live in the instance: two's-complement wraparound for fixed-width integers (e.g. int32 addition reduces x + y modulo 2^32 and reinterprets as signed, wrapping silently on overflow), IEEE 754 round-to-nearest for floating-point, and arbitrary precision for bigint.", + "Requires a 'numeric' type-class constraint on the argument type, which is the closest Hydra equivalent to Haskell's Num instance.", + "The operation is total. Corresponds to Haskell's (+) :: Num a => a -> a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "arg0"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "arg1"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -163,13 +169,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first addend"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second addend"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -195,8 +201,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the sine value whose arc sine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -221,8 +227,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose inverse hyperbolic sine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -247,8 +253,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the tangent value whose arc tangent is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -274,13 +280,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the ordinate (y-coordinate)"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the abscissa (x-coordinate)"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -305,8 +311,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose inverse hyperbolic tangent is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -332,8 +338,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to round up toward positive infinity"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -358,8 +364,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the angle in radians"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -384,8 +390,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose hyperbolic cosine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -395,6 +401,39 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +div :: Packaging.PrimitiveDefinition +div = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.div"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Integer division, or Nothing if dividing by zero."), + Packaging.entityMetadataComments = [ + "Total integer division: div(x, y) returns Just(x divided by y, rounded toward negative infinity) when y is non-zero, and Nothing when y = 0.", + "The division rounds toward negative infinity (floor), so for example div(-7, 2) = Just(-4).", + "The boundary case div(minBound, -1), whose mathematical result +2147483648 is not representable in int32, wraps to minBound (the two's-complement overflow).", + "Corresponds to Haskell's div :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the dividend"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the divisor"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + e :: Packaging.PrimitiveDefinition e = Packaging.PrimitiveDefinition { @@ -431,8 +470,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the integer to test for evenness"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -448,11 +487,11 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")), Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.fromOptional")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")), Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})), Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeMod")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mod")), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))}))}))})), Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))} @@ -472,8 +511,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the exponent"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -499,8 +538,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to round down toward negative infinity"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -525,8 +564,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose natural logarithm is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -552,13 +591,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "b"), + Typing.parameterDescription = (Just "the logarithm base"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose logarithm is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -568,79 +607,15 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -max :: Packaging.PrimitiveDefinition -max = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.max"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "The maximum of two integers."), - Packaging.entityMetadataComments = [ - "Return the larger of two int32 values under the usual signed-integer total order.", - "Total on all inputs. Corresponds to Haskell's max :: Int32 -> Int32 -> Int32."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -maybeDiv :: Packaging.PrimitiveDefinition -maybeDiv = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.maybeDiv"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Integer division, or Nothing if dividing by zero."), - Packaging.entityMetadataComments = [ - "Total integer division: maybeDiv(x, y) returns Just(x divided by y, rounded toward negative infinity) when y is non-zero, and Nothing when y = 0.", - "The division rounds toward negative infinity (floor), so for example maybeDiv(-7, 2) = Just(-4).", - "The boundary case maybeDiv(minBound, -1), whose mathematical result +2147483648 is not representable in int32, wraps to minBound (the two's-complement overflow).", - "Corresponds to Haskell's div :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -maybeMod :: Packaging.PrimitiveDefinition -maybeMod = +mod :: Packaging.PrimitiveDefinition +mod = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.maybeMod"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.mod"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Integer modulus, or Nothing if dividing by zero."), Packaging.entityMetadataComments = [ - "Total integer modulus: maybeMod(x, y) returns Just(x mod y) when y is non-zero, and Nothing when y = 0.", - "The result satisfies the identity x = (maybeDiv(x, y) result) * y + (maybeMod(x, y) result), so the sign of the result matches the sign of y (Knuth-style floor division). For example maybeMod(-7, 2) = Just(1).", + "Total integer modulus: mod(x, y) returns Just(x mod y) when y is non-zero, and Nothing when y = 0.", + "The result satisfies the identity x = (div(x, y) result) * y + (mod(x, y) result), so the sign of the result matches the sign of y (Knuth-style floor division). For example mod(-7, 2) = Just(1).", "Corresponds to Haskell's mod :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -648,98 +623,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -maybePred :: Packaging.PrimitiveDefinition -maybePred = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.maybePred"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "The predecessor of an integer, or Nothing on underflow."), - Packaging.entityMetadataComments = [ - "maybePred(x) returns Just(x - 1) when x > minBound, and Nothing when x = minBound (i.e. -2147483648). The function is total and does not wrap.", - "Corresponds to Haskell's pred :: Int32 -> Int32, wrapped in maybe to make the boundary case total (Haskell's pred is a partial function that raises an error on minBound)."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -maybeRem :: Packaging.PrimitiveDefinition -maybeRem = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.maybeRem"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Integer remainder, or Nothing if dividing by zero."), - Packaging.entityMetadataComments = [ - "Total integer remainder: maybeRem(x, y) returns Just(x rem y) when y is non-zero, and Nothing when y = 0.", - "The result satisfies x = (truncate(x / y)) * y + (maybeRem(x, y) result), so the sign of the result matches the sign of x (truncated division, C-style remainder). For example maybeRem(-7, 2) = Just(-1).", - "The boundary case maybeRem(minBound, -1) is 0 (no overflow, since the quotient overflow is absorbed).", - "Corresponds to Haskell's rem :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the dividend"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - -maybeSucc :: Packaging.PrimitiveDefinition -maybeSucc = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.maybeSucc"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "The successor of an integer, or Nothing on overflow."), - Packaging.entityMetadataComments = [ - "maybeSucc(x) returns Just(x + 1) when x < maxBound, and Nothing when x = maxBound (i.e. 2147483647). The function is total and does not wrap.", - "Corresponds to Haskell's succ :: Int32 -> Int32, wrapped in maybe to make the boundary case total (Haskell's succ is a partial function that raises an error on maxBound)."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the divisor"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -749,64 +639,38 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -min :: Packaging.PrimitiveDefinition -min = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.min"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "The minimum of two integers."), - Packaging.entityMetadataComments = [ - "Return the smaller of two int32 values under the usual signed-integer total order.", - "Total on all inputs. Corresponds to Haskell's min :: Int32 -> Int32 -> Int32."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - mul :: Packaging.PrimitiveDefinition mul = Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.mul"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Integer multiplication."), + Packaging.entityMetadataDescription = (Just "Numeric multiplication."), Packaging.entityMetadataComments = [ - "Two's-complement 32-bit signed integer multiplication. The result is x * y reduced modulo 2^32 and reinterpreted as a signed int32 (i.e. arithmetic wraps silently on overflow, with no exception raised).", - "The operation is total. Corresponds to Haskell's (*) :: Int32 -> Int32 -> Int32."], + "Constraint-polymorphic multiplication over any type with a 'numeric' instance. The per-type semantics live in the instance: two's-complement wraparound for fixed-width integers (e.g. int32 multiplication reduces x * y modulo 2^32 and reinterprets as signed, wrapping silently on overflow), IEEE 754 round-to-nearest for floating-point, and arbitrary precision for bigint.", + "Requires a 'numeric' type-class constraint on the argument type.", + "The operation is total. Corresponds to Haskell's (*) :: Num a => a -> a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "arg0"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "arg1"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -827,13 +691,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first factor"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second factor"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -848,24 +712,28 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.negate"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Negate an integer."), + Packaging.entityMetadataDescription = (Just "Numeric negation."), Packaging.entityMetadataComments = [ - "Arithmetic negation of a 32-bit signed integer. The result is 0 - x reduced modulo 2^32 and reinterpreted as a signed int32.", - "The function is total but not injective at the boundary: negate(minBound) = minBound (i.e. negate(-2147483648) = -2147483648), because +2147483648 is not representable in int32.", - "Corresponds to Haskell's negate :: Int32 -> Int32."], + "Constraint-polymorphic arithmetic negation over any type with a 'numeric' instance. The per-type semantics live in the instance: for fixed-width integers the result is 0 - x reduced modulo 2^32 and reinterpreted as signed (total but not injective at the boundary: negate(minBound) = minBound, because +2147483648 is not representable in int32); for floating-point it flips the sign bit per IEEE 754 \2677.5.1.", + "Requires a 'numeric' type-class constraint on the argument type.", + "Corresponds to Haskell's negate :: Num a => a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "arg0"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -885,8 +753,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to negate"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -911,8 +779,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the integer to test for oddness"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -966,13 +834,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the base"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the exponent"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -997,13 +865,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "a"), + Typing.parameterDescription = (Just "the inclusive lower bound of the range"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "b"), + Typing.parameterDescription = (Just "the inclusive upper bound of the range"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1013,6 +881,39 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +rem :: Packaging.PrimitiveDefinition +rem = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.rem"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Integer remainder, or Nothing if dividing by zero."), + Packaging.entityMetadataComments = [ + "Total integer remainder: rem(x, y) returns Just(x rem y) when y is non-zero, and Nothing when y = 0.", + "The result satisfies x = (truncate(x / y)) * y + (rem(x, y) result), so the sign of the result matches the sign of x (truncated division, C-style remainder). For example rem(-7, 2) = Just(-1).", + "The boundary case rem(minBound, -1) is 0 (no overflow, since the quotient overflow is absorbed).", + "Corresponds to Haskell's rem :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the dividend"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the divisor"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + round :: Packaging.PrimitiveDefinition round = Packaging.PrimitiveDefinition { @@ -1029,8 +930,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to round to the nearest integer"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1056,13 +957,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "n"), + Typing.parameterDescription = (Just "the number of decimal places to round to"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float32 value to round"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1088,13 +989,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "n"), + Typing.parameterDescription = (Just "the number of decimal places to round to"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the float64 value to round"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1120,8 +1021,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the integer whose sign is returned"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1146,8 +1047,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the angle in radians"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1172,8 +1073,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose hyperbolic sine is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1199,8 +1100,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose square root is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1215,28 +1116,33 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.sub"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Integer subtraction."), + Packaging.entityMetadataDescription = (Just "Numeric subtraction."), Packaging.entityMetadataComments = [ - "Two's-complement 32-bit signed integer subtraction. The result is x - y reduced modulo 2^32 and reinterpreted as a signed int32 (i.e. arithmetic wraps silently on overflow, with no exception raised).", - "The operation is total. Corresponds to Haskell's (-) :: Int32 -> Int32 -> Int32."], + "Constraint-polymorphic subtraction over any type with a 'numeric' instance. The per-type semantics live in the instance: two's-complement wraparound for fixed-width integers (e.g. int32 subtraction reduces x - y modulo 2^32 and reinterprets as signed, wrapping silently on overflow), IEEE 754 round-to-nearest for floating-point, and arbitrary precision for bigint.", + "Requires a 'numeric' type-class constraint on the argument type.", + "The operation is total. Corresponds to Haskell's (-) :: Num a => a -> a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "arg0"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "arg1"), Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}}, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} @@ -1257,13 +1163,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the minuend"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the subtrahend"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1288,8 +1194,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the angle in radians"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1314,8 +1220,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value whose hyperbolic tangent is computed"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -1341,8 +1247,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to truncate toward zero"), Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Optionals.hs b/src/main/haskell/Hydra/Lib/Optionals.hs --- a/src/main/haskell/Hydra/Lib/Optionals.hs +++ b/src/main/haskell/Hydra/Lib/Optionals.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -57,15 +58,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "mf"), + Typing.parameterDescription = (Just "the optional function"), Typing.parameterType = (Core.TypeOptional (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))}))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "mx"), + Typing.parameterDescription = (Just "the optional argument"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -119,13 +120,13 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional value to bind"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the continuation to apply to the contained value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))})), @@ -171,18 +172,18 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional value to eliminate"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "def"), + Typing.parameterDescription = (Just "the value to return when the optional is none"), Typing.parameterType = (Core.TypeVariable (Core.Name "y")), Typing.parameterIsLazy = True}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to the contained value when the optional is given"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), @@ -194,63 +195,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -cat :: Packaging.PrimitiveDefinition -cat = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.cat"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Concatenate optionals, keeping only the present values."), - Packaging.entityMetadataComments = [ - "cat(xs) returns the list of contained values from given elements of xs, in original order; none elements are discarded.", - "Total. Corresponds to Haskell's Data.Maybe.catMaybes :: [Maybe a] -> [a]."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [ - Typing.TypeParameter { - Typing.typeParameterName = (Core.Name "x"), - Typing.typeParameterConstraints = []}], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeList (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), - Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "v"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), - Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), - Core.applicationArgument = (Core.TermList [])})), - Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))})))} - compose :: Packaging.PrimitiveDefinition compose = Packaging.PrimitiveDefinition { @@ -276,22 +220,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the first Kleisli arrow"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the second Kleisli arrow"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "z")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to apply the composition to"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -316,55 +260,144 @@ Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))}))}))})))} -fromOptional :: Packaging.PrimitiveDefinition -fromOptional = +foldList :: Packaging.PrimitiveDefinition +foldList = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.fromOptional"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.foldList"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Return the value contained in an optional, falling back to a default if absent."), + Packaging.entityMetadataDescription = (Just "Left-fold over a list with an optional-returning function, short-circuiting on none."), Packaging.entityMetadataComments = [ - "fromOptional(def, m) returns x when m is given(x), and def when m is none.", - "Total. Corresponds to Haskell's Data.Maybe.fromMaybe :: a -> Maybe a -> a."], + "foldList(f, acc, xs) folds f over xs from the left, iterating while each application yields given, and returns none as soon as any step yields none. If every element is processed, the result is given of the final accumulator.", + "foldList(f, acc, xs) is lists.foldl(\\m y -> bind(m, \\x -> f(x, y)), pure(acc), xs); this defining equation is the specification, and the default implementation.", + "Total. Corresponds to a short-circuiting foldM specialised to Maybe."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature { Typing.termSignatureTypeParameters = [ Typing.TypeParameter { Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the optional-returning step function"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "acc"), + Typing.parameterDescription = (Just "the initial accumulator"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), - Typing.parameterIsLazy = True}, + Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to fold over"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, + Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), + Core.lambdaParameter = (Core.Name "f"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), + Core.lambdaParameter = (Core.Name "acc"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), - Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "def"))})), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))}))}))})))} + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldl")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))})))} +givens :: Packaging.PrimitiveDefinition +givens = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.givens"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Concatenate optionals, keeping only the present values."), + Packaging.entityMetadataComments = [ + "givens(xs) returns the list of contained values from given elements of xs, in original order; none elements are discarded.", + "Total. Corresponds to Haskell's Data.Maybe.catMaybes :: [Maybe a] -> [a]."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of optionals to concatenate"), + Typing.parameterType = (Core.TypeList (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "v"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermList [])})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))})))} + isGiven :: Packaging.PrimitiveDefinition isGiven = Packaging.PrimitiveDefinition { @@ -383,8 +416,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to test"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -424,8 +457,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to test"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -469,15 +502,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to the contained value"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to map over"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -504,6 +537,85 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "f")), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))))}))}))}))})))} +mapList :: Packaging.PrimitiveDefinition +mapList = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.mapList"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Traverse a list in the optional monad."), + Packaging.entityMetadataComments = [ + "mapList(f, xs) applies f to each element of xs. If every application yields given, the result is given of the list of contained values, in their original order. The result is none as soon as any application yields none.", + "Total. Corresponds to Haskell's traverse :: (a -> Maybe b) -> [a] -> Maybe [b]."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the optional-returning function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to traverse"), + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeList (Core.TypeVariable (Core.Name "y"))))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "xs"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermList [])}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))})))} + mapOptional :: Packaging.PrimitiveDefinition mapOptional = Packaging.PrimitiveDefinition { @@ -525,15 +637,15 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the partial function to apply to each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list to map over"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -548,13 +660,106 @@ Core.lambdaParameter = (Core.Name "xs"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cat")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.givens")), Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.map")), Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}))}))})))} +mapSet :: Packaging.PrimitiveDefinition +mapSet = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.mapSet"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Traverse a set in the optional monad."), + Packaging.entityMetadataComments = [ + "mapSet(f, s) applies f to each element of s. If every application yields given, the result is given of the set of contained values, deduplicated by the result type's ordering. The result is none as soon as any application yields none.", + "Requires 'ordering' constraints on both element types (the set type contract).", + "Total. Corresponds to a traverse-style operation specialised to Set in the Maybe monad."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}, + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "y"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the optional-returning function to apply to each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to traverse"), + Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeSet (Core.TypeVariable (Core.Name "y"))))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "f"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.foldr")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "acc"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.bind")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "f")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.map")), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "ys"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.cons")), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "ys"))}))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "acc"))}))}))}))}))}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Core.TermList [])}))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))})))} + pure :: Packaging.PrimitiveDefinition pure = Packaging.PrimitiveDefinition { @@ -573,8 +778,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the value to wrap in given"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -605,8 +810,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to convert"), Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -628,3 +833,52 @@ Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermList [ Core.TermVariable (Core.Name "x")])}))}))})))} + +withDefault :: Packaging.PrimitiveDefinition +withDefault = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.optionals.withDefault"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the value contained in an optional, falling back to a default if absent."), + Packaging.entityMetadataComments = [ + "withDefault(def, m) returns x when m is given(x), and def when m is none.", + "Total. Corresponds to Haskell's Data.Maybe.fromMaybe :: a -> Maybe a -> a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = []}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "def"), + Typing.parameterDescription = (Just "the default value to return when the optional is none"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = True}, + Typing.Parameter { + Typing.parameterName = (Core.Name "m"), + Typing.parameterDescription = (Just "the optional to unwrap"), + Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "def"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "m"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "def"))})), + Core.applicationArgument = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))}))}))})))} diff --git a/src/main/haskell/Hydra/Lib/Ordering.hs b/src/main/haskell/Hydra/Lib/Ordering.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Ordering.hs @@ -0,0 +1,329 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.ordering module. + +module Hydra.Lib.Ordering where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +compare :: Packaging.PrimitiveDefinition +compare = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.compare"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Compare two values and return a Comparison."), + Packaging.entityMetadataComments = [ + "compare(x, y) returns the hydra.util.Comparison value that classifies the relationship between x and y under the type's ordering: LessThan if x < y, EqualTo if x == y, GreaterThan if x > y.", + "The result type's three-valued tag is the canonical primitive comparison; the boolean comparators (lt/lte/gt/gte) are derivable from it.", + "Requires an 'ordering' type-class constraint on the argument type, which is the closest Hydra equivalent to Haskell's Ord instance.", + "Since: 0.18 (moved from hydra.lib.equality.compare).", + "Total. Corresponds to Haskell's compare :: Ord a => a -> a -> Ordering."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "hydra.util.Comparison"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +gt :: Packaging.PrimitiveDefinition +gt = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.gt"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether the first value is greater than the second."), + Packaging.entityMetadataComments = [ + "gt(x, y) returns true iff x > y under the type's ordering.", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.gt).", + "Total. Corresponds to Haskell's (>) :: Ord a => a -> a -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +gte :: Packaging.PrimitiveDefinition +gte = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.gte"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether the first value is greater than or equal to the second."), + Packaging.entityMetadataComments = [ + "gte(x, y) returns true iff x >= y under the type's ordering.", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.gte).", + "Total. Corresponds to Haskell's (>=) :: Ord a => a -> a -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +lt :: Packaging.PrimitiveDefinition +lt = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.lt"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether the first value is less than the second."), + Packaging.entityMetadataComments = [ + "lt(x, y) returns true iff x < y under the type's ordering.", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.lt).", + "Total. Corresponds to Haskell's (<) :: Ord a => a -> a -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +lte :: Packaging.PrimitiveDefinition +lte = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.lte"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Check whether the first value is less than or equal to the second."), + Packaging.entityMetadataComments = [ + "lte(x, y) returns true iff x <= y under the type's ordering.", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.lte).", + "Total. Corresponds to Haskell's (<=) :: Ord a => a -> a -> Bool."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +max :: Packaging.PrimitiveDefinition +max = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.max"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the maximum of two values."), + Packaging.entityMetadataComments = [ + "max(x, y) returns the larger of x and y under the type's ordering; if x == y, it returns y (matching Haskell's convention).", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.max).", + "Total. Corresponds to Haskell's max :: Ord a => a -> a -> a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.gte")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))} + +min :: Packaging.PrimitiveDefinition +min = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.ordering.min"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Return the minimum of two values."), + Packaging.entityMetadataComments = [ + "min(x, y) returns the smaller of x and y under the type's ordering; if x == y, it returns x (matching Haskell's convention).", + "Requires an 'ordering' constraint on the argument type.", + "Since: 0.18 (moved from hydra.lib.equality.min).", + "Total. Corresponds to Haskell's min :: Ord a => a -> a -> a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the first value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "y"), + Typing.parameterDescription = (Just "the second value to compare"), + Typing.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "y"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.ifElse")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.ordering.lte")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))} diff --git a/src/main/haskell/Hydra/Lib/Pairs.hs b/src/main/haskell/Hydra/Lib/Pairs.hs --- a/src/main/haskell/Hydra/Lib/Pairs.hs +++ b/src/main/haskell/Hydra/Lib/Pairs.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -62,22 +63,22 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function applied to the first element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "a")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "c"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "g"), + Typing.parameterDescription = (Just "the function applied to the second element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "b")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "d"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the pair to map over"), Typing.parameterType = (Core.TypePair (Core.PairType { Core.pairTypeFirst = (Core.TypeVariable (Core.Name "a")), Core.pairTypeSecond = (Core.TypeVariable (Core.Name "b"))})), @@ -131,8 +132,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the pair whose first element is returned"), Typing.parameterType = (Core.TypePair (Core.PairType { Core.pairTypeFirst = (Core.TypeVariable (Core.Name "a")), Core.pairTypeSecond = (Core.TypeVariable (Core.Name "b"))})), @@ -165,8 +166,8 @@ Typing.typeParameterConstraints = []}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "p"), + Typing.parameterDescription = (Just "the pair whose second element is returned"), Typing.parameterType = (Core.TypePair (Core.PairType { Core.pairTypeFirst = (Core.TypeVariable (Core.Name "a")), Core.pairTypeSecond = (Core.TypeVariable (Core.Name "b"))})), diff --git a/src/main/haskell/Hydra/Lib/Regex.hs b/src/main/haskell/Hydra/Lib/Regex.hs --- a/src/main/haskell/Hydra/Lib/Regex.hs +++ b/src/main/haskell/Hydra/Lib/Regex.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -51,13 +52,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to search for"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to search within"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -83,13 +84,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to search for"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to search within"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -115,13 +116,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to test"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to test against"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -148,18 +149,18 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to match"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "repl"), + Typing.parameterDescription = (Just "the replacement string"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to operate on"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -185,18 +186,18 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to match"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "repl"), + Typing.parameterDescription = (Just "the replacement string"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg2"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to operate on"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -223,13 +224,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "pat"), + Typing.parameterDescription = (Just "the regex pattern to split on"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to split"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Sets.hs b/src/main/haskell/Hydra/Lib/Sets.hs --- a/src/main/haskell/Hydra/Lib/Sets.hs +++ b/src/main/haskell/Hydra/Lib/Sets.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -55,13 +56,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the element to remove"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to remove the element from"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -91,13 +92,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s1"), + Typing.parameterDescription = (Just "the set to subtract from"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s2"), + Typing.parameterDescription = (Just "the set of elements to remove"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -167,6 +168,58 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +filter :: Packaging.PrimitiveDefinition +filter = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.sets.filter"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Filter a set by a predicate."), + Packaging.entityMetadataComments = [ + "filter(p, s) returns the subset of s containing exactly the elements x for which p(x) is true.", + "Requires an 'ordering' constraint on the element type.", + "Total. Corresponds to Haskell's Data.Set.filter :: (a -> Bool) -> Set a -> Set a."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [ + Typing.TypeParameter { + Typing.typeParameterName = (Core.Name "x"), + Typing.typeParameterConstraints = [ + Core.TypeClassConstraintSimple (Core.Name "ordering")]}], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "predicate"), + Typing.parameterDescription = (Just "the predicate to test each element"), + Typing.parameterType = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), + Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to filter"), + Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "p"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "s"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.filter")), + Core.applicationArgument = (Core.TermVariable (Core.Name "p"))})), + Core.applicationArgument = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))})))} + fromList :: Packaging.PrimitiveDefinition fromList = Packaging.PrimitiveDefinition { @@ -187,8 +240,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of elements to build the set from"), Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -218,13 +271,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the element to add"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to add the element to"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -254,13 +307,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s1"), + Typing.parameterDescription = (Just "the first set"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s2"), + Typing.parameterDescription = (Just "the second set"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -328,15 +381,15 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "f"), + Typing.parameterDescription = (Just "the function to apply to each element"), Typing.parameterType = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "x")), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "y"))})), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to map over"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -380,13 +433,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the element to test for membership"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to test against"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -416,8 +469,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to test for emptiness"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -447,8 +500,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "x"), + Typing.parameterDescription = (Just "the single element of the set"), Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -478,8 +531,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set whose size is returned"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -509,8 +562,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the set to convert to a list"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -540,13 +593,13 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s1"), + Typing.parameterDescription = (Just "the first set"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s2"), + Typing.parameterDescription = (Just "the second set"), Typing.parameterType = (Core.TypeSet (Core.TypeVariable (Core.Name "x"))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -600,8 +653,8 @@ Core.TypeClassConstraintSimple (Core.Name "ordering")]}], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "ss"), + Typing.parameterDescription = (Just "the list of sets to union together"), Typing.parameterType = (Core.TypeList (Core.TypeSet (Core.TypeVariable (Core.Name "x")))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/Strings.hs b/src/main/haskell/Hydra/Lib/Strings.hs --- a/src/main/haskell/Hydra/Lib/Strings.hs +++ b/src/main/haskell/Hydra/Lib/Strings.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -35,14 +36,45 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci -cat :: Packaging.PrimitiveDefinition -cat = +charAt :: Packaging.PrimitiveDefinition +charAt = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.cat"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.charAt"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Get the Unicode code point of the character at a specific index, returning Nothing if out of bounds."), + Packaging.entityMetadataComments = [ + "charAt(i, s) returns Just(c) where c is the Unicode code point at position i in s, or Nothing if i is negative or i >= length(s).", + "Total."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "i"), + Typing.parameterDescription = (Just "the index of the character to retrieve"), + Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to index into"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +concat :: Packaging.PrimitiveDefinition +concat = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.concat"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Concatenate a list of strings into a single string."), Packaging.entityMetadataComments = [ - "cat(xs) returns the string formed by concatenating every string in xs in order.", + "concat(xs) returns the string formed by concatenating every string in xs in order.", "Total. Corresponds to Haskell's concat :: [String] -> String."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -50,8 +82,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of strings to concatenate"), Typing.parameterType = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -61,14 +93,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -cat2 :: Packaging.PrimitiveDefinition -cat2 = +concat2 :: Packaging.PrimitiveDefinition +concat2 = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.cat2"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.concat2"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Concatenate two strings."), Packaging.entityMetadataComments = [ - "cat2(s, t) returns the concatenation of s and t.", + "concat2(s, t) returns the concatenation of s and t.", "Total. Corresponds to Haskell's (++) :: String -> String -> String."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -76,13 +108,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the first string"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "t"), + Typing.parameterDescription = (Just "the second string"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -108,8 +140,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "cs"), + Typing.parameterDescription = (Just "the list of Unicode code points to convert"), Typing.parameterType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -119,14 +151,14 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -intercalate :: Packaging.PrimitiveDefinition -intercalate = +join :: Packaging.PrimitiveDefinition +join = Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.intercalate"), + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.join"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { Packaging.entityMetadataDescription = (Just "Join a list of strings with a separator between each element."), Packaging.entityMetadataComments = [ - "intercalate(sep, xs) returns the strings in xs concatenated with sep inserted between each pair of adjacent strings; for the empty list the result is the empty string, and for a singleton list the result is the single string.", + "join(sep, xs) returns the strings in xs concatenated with sep inserted between each pair of adjacent strings; for the empty list the result is the empty string, and for a singleton list the result is the single string.", "Total. Corresponds to Haskell's Data.List.intercalate :: String -> [String] -> String."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), @@ -134,13 +166,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "sep"), + Typing.parameterDescription = (Just "the separator to insert between elements"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of strings to join"), Typing.parameterType = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -166,8 +198,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to measure"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -193,8 +225,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to split into lines"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -204,37 +236,6 @@ Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} -maybeCharAt :: Packaging.PrimitiveDefinition -maybeCharAt = - Packaging.PrimitiveDefinition { - Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.strings.maybeCharAt"), - Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just "Get the Unicode code point of the character at a specific index, returning Nothing if out of bounds."), - Packaging.entityMetadataComments = [ - "maybeCharAt(i, s) returns Just(c) where c is the Unicode code point at position i in s, or Nothing if i is negative or i >= length(s).", - "Total."], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.primitiveDefinitionSignature = Typing.TermSignature { - Typing.termSignatureTypeParameters = [], - Typing.termSignatureParameters = [ - Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)), - Typing.parameterIsLazy = False}, - Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, - Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), - Typing.parameterIsLazy = False}], - Typing.termSignatureResult = Typing.Result { - Typing.resultDescription = Nothing, - Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}}, - Packaging.primitiveDefinitionIsPure = True, - Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = Nothing} - null :: Packaging.PrimitiveDefinition null = Packaging.PrimitiveDefinition { @@ -250,8 +251,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to test for emptiness"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -277,13 +278,13 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "sep"), + Typing.parameterDescription = (Just "the delimiter to split on"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}, Typing.Parameter { - Typing.parameterName = (Core.Name "arg1"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to split"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -308,8 +309,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to convert"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -336,8 +337,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to convert to lowercase"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -364,8 +365,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "s"), + Typing.parameterDescription = (Just "the string to convert to uppercase"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -390,8 +391,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "xs"), + Typing.parameterDescription = (Just "the list of strings to join with newlines"), Typing.parameterType = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString)), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Lib/System.hs b/src/main/haskell/Hydra/Lib/System.hs --- a/src/main/haskell/Hydra/Lib/System.hs +++ b/src/main/haskell/Hydra/Lib/System.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -49,8 +50,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "command"), + Typing.parameterDescription = (Just "the program and arguments to run"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.system.Command")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -76,8 +77,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "code"), + Typing.parameterDescription = (Just "the status code to terminate the process with"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.system.StatusCode")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -123,8 +124,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "name"), + Typing.parameterDescription = (Just "the name of the environment variable to look up"), Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.system.EnvironmentVariable")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -172,6 +173,82 @@ Typing.resultType = (Core.TypeEffect (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.error.system.SystemError")), Core.eitherTypeRight = (Core.TypeVariable (Core.Name "hydra.file.FilePath"))})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +readStdin :: Packaging.PrimitiveDefinition +readStdin = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.readStdin"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Read the complete contents of standard input as raw bytes."), + Packaging.entityMetadataComments = [ + "readStdin describes an effectful computation which reads standard input (POSIX file descriptor 0) until end-of-file and returns the complete contents as raw bytes, with no character decoding or newline translation -- the POSIX read() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/read.html) applied repeatedly to fd 0 until it signals end-of-file. To interpret the result as text, decode it (e.g. via hydra.lib.text.decodeUtf8). A recoverable I/O failure is returned as left(error); success is returned as right(contents), including the empty byte string if stdin is closed or empty."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.error.system.SystemError")), + Core.eitherTypeRight = (Core.TypeLiteral Core.LiteralTypeBinary)})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +writeStderr :: Packaging.PrimitiveDefinition +writeStderr = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.writeStderr"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Write raw bytes to standard error."), + Packaging.entityMetadataComments = [ + "writeStderr(bytes) describes an effectful computation which writes bytes to standard error (POSIX file descriptor 2), with no character encoding or newline translation -- the POSIX write() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/write.html) applied repeatedly to fd 2 until all bytes are written. To write text, encode it first (e.g. via hydra.lib.text.encodeUtf8). A recoverable I/O failure (for example a closed pipe, POSIX EPIPE) is returned as left(error); success is returned as right(unit)."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "bytes"), + Typing.parameterDescription = (Just "the raw bytes to write to standard error"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.error.system.SystemError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +writeStdout :: Packaging.PrimitiveDefinition +writeStdout = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.writeStdout"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Write raw bytes to standard output."), + Packaging.entityMetadataComments = [ + "writeStdout(bytes) describes an effectful computation which writes bytes to standard output (POSIX file descriptor 1), with no character encoding or newline translation -- the POSIX write() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/write.html) applied repeatedly to fd 1 until all bytes are written. To write text, encode it first (e.g. via hydra.lib.text.encodeUtf8). A recoverable I/O failure (for example a closed pipe, POSIX EPIPE) is returned as left(error); success is returned as right(unit)."], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.primitiveDefinitionSignature = Typing.TermSignature { + Typing.termSignatureTypeParameters = [], + Typing.termSignatureParameters = [ + Typing.Parameter { + Typing.parameterName = (Core.Name "bytes"), + Typing.parameterDescription = (Just "the raw bytes to write to standard output"), + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.error.system.SystemError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, Packaging.primitiveDefinitionIsPure = False, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} diff --git a/src/main/haskell/Hydra/Lib/Text.hs b/src/main/haskell/Hydra/Lib/Text.hs --- a/src/main/haskell/Hydra/Lib/Text.hs +++ b/src/main/haskell/Hydra/Lib/Text.hs @@ -21,6 +21,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -50,8 +51,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "bytes"), + Typing.parameterDescription = (Just "the byte sequence to decode as UTF-8"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBinary), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { @@ -78,8 +79,8 @@ Typing.termSignatureTypeParameters = [], Typing.termSignatureParameters = [ Typing.Parameter { - Typing.parameterName = (Core.Name "arg0"), - Typing.parameterDescription = Nothing, + Typing.parameterName = (Core.Name "text"), + Typing.parameterDescription = (Just "the text to encode as UTF-8"), Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeString), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { diff --git a/src/main/haskell/Hydra/Literals.hs b/src/main/haskell/Hydra/Literals.hs --- a/src/main/haskell/Hydra/Literals.hs +++ b/src/main/haskell/Hydra/Literals.hs @@ -22,6 +22,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Names.hs b/src/main/haskell/Hydra/Names.hs --- a/src/main/haskell/Hydra/Names.hs +++ b/src/main/haskell/Hydra/Names.hs @@ -34,6 +34,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -56,7 +57,7 @@ let tryLabel = \index -> - let candidate = Logic.ifElse (Equality.equal index 1) label (Strings.cat2 label (Literals.showInt32 index)) + let candidate = Logic.ifElse (Equality.equal index 1) label (Strings.concat2 label (Literals.showInt32 index)) in (Logic.ifElse (Sets.member candidate reserved) (tryLabel (Math.add index 1)) candidate) in (tryLabel 1) @@ -67,11 +68,38 @@ let qualName = qualifyName name mns = Util.qualifiedNameModuleName qualName local = Util.qualifiedNameLocal qualName - in (Optionals.cases mns (Core.unName name) (\ns -> Optionals.cases (Maps.lookup ns namespaces) local (\pre -> Strings.cat [ + in (Optionals.cases mns (Core.unName name) (\ns -> Optionals.cases (Maps.lookup ns namespaces) local (\pre -> Strings.concat [ pre, ":", local]))) +-- | Generate a binding name for a derived function from a type/term name, given the category's namespace segments +derivedBindingName :: [String] -> Bool -> Core.Name -> Core.Name +derivedBindingName categoryPrefix alwaysDropFirst n = + derivedDefinitionName categoryPrefix alwaysDropFirst False n (Formatting.decapitalize (localNameOf n)) + +-- | Generate a derived element name from a source name's namespace and an explicit local name +derivedDefinitionName :: [String] -> Bool -> Bool -> Core.Name -> String -> Core.Name +derivedDefinitionName categoryPrefix alwaysDropFirst prefixWhenNoNamespace n localName = + + let localResult = Core.Name localName + prefixedResult = Core.Name (Strings.join "." (Lists.concat2 categoryPrefix [ + localName])) + noNamespaceResult = Logic.ifElse prefixWhenNoNamespace prefixedResult localResult + in (Optionals.cases (Lists.init (Strings.splitOn "." (Core.unName n))) noNamespaceResult (\nsParts -> Optionals.cases (Lists.uncons nsParts) noNamespaceResult (\nsHeadTail -> + let categoryPrefixResolved = + Logic.ifElse (Logic.or alwaysDropFirst (Equality.equal (Pairs.first nsHeadTail) "hydra")) (Lists.concat2 categoryPrefix (Pairs.second nsHeadTail)) (Lists.concat2 categoryPrefix nsParts) + in (Core.Name (Strings.join "." (Lists.concat2 categoryPrefixResolved [ + localName])))))) + +-- | Generate a derived module name from a source module name, given the category's namespace segments +derivedModuleName :: [String] -> Bool -> Packaging.ModuleName -> Packaging.ModuleName +derivedModuleName categoryPrefix alwaysDropFirst ns = + + let parts = Strings.splitOn "." (Packaging.unModuleName ns) + fallback = Packaging.ModuleName (Strings.join "." (Lists.concat2 categoryPrefix parts)) + in (Optionals.cases (Lists.uncons parts) fallback (\ht -> Logic.ifElse (Logic.or alwaysDropFirst (Equality.equal (Pairs.first ht) "hydra")) (Packaging.ModuleName (Strings.join "." (Lists.concat2 categoryPrefix (Pairs.second ht)))) fallback)) + -- | Generate a fresh type variable name, threading InferenceContext freshName :: Typing.InferenceContext -> (Core.Name, Typing.InferenceContext) freshName cx = @@ -110,7 +138,7 @@ moduleNameToFilePath caseConv ext ns = let parts = Lists.map (Formatting.convertCase Util.CaseConventionCamel caseConv) (Strings.splitOn "." (Packaging.unModuleName ns)) - in (Strings.cat2 (Strings.cat2 (Strings.intercalate "/" parts) ".") (File.unFileExtension ext)) + in (Strings.concat2 (Strings.concat2 (Strings.join "/" parts) ".") (File.unFileExtension ext)) -- | Convert a name to file path, given case conventions for namespaces and local names, and assuming '/' as the file path separator nameToFilePath :: Util.CaseConvention -> Util.CaseConvention -> File.FileExtension -> Core.Name -> String @@ -120,10 +148,10 @@ ns = Util.qualifiedNameModuleName qualName local = Util.qualifiedNameLocal qualName nsToFilePath = - \nsArg -> Strings.intercalate "/" (Lists.map (\part -> Formatting.convertCase Util.CaseConventionCamel nsConv part) (Strings.splitOn "." (Packaging.unModuleName nsArg))) - prefix = Optionals.cases ns "" (\n -> Strings.cat2 (nsToFilePath n) "/") + \nsArg -> Strings.join "/" (Lists.map (\part -> Formatting.convertCase Util.CaseConventionCamel nsConv part) (Strings.splitOn "." (Packaging.unModuleName nsArg))) + prefix = Optionals.cases ns "" (\n -> Strings.concat2 (nsToFilePath n) "/") suffix = Formatting.convertCase Util.CaseConventionPascal localConv local - in (Strings.cat [ + in (Strings.concat [ prefix, suffix, ".", @@ -131,7 +159,7 @@ -- | Type variable naming convention follows Haskell: t0, t1, etc. normalTypeVariable :: Int -> Core.Name -normalTypeVariable i = Core.Name (Strings.cat2 "t" (Literals.showInt32 i)) +normalTypeVariable i = Core.Name (Strings.concat2 "t" (Literals.showInt32 i)) -- | Prepend a SubtermStep to the InferenceContext's trace. The trace is accumulated backwards as inference descends through subterms; at error-emission time the list is reversed and wrapped into a SubtermPath stamped onto the error. pushSubtermStep :: Paths.SubtermStep -> Typing.InferenceContext -> Typing.InferenceContext @@ -143,7 +171,7 @@ -- | Construct a qualified (dot-separated) name qname :: Packaging.ModuleName -> String -> Core.Name qname ns name = - Core.Name (Strings.cat [ + Core.Name (Strings.concat [ Packaging.unModuleName ns, ".", name]) @@ -161,7 +189,7 @@ in (Logic.ifElse (Lists.null restReversed) (Util.QualifiedName { Util.qualifiedNameModuleName = Nothing, Util.qualifiedNameLocal = (Core.unName name)}) (Util.QualifiedName { - Util.qualifiedNameModuleName = (Just (Packaging.ModuleName (Strings.intercalate "." (Lists.reverse restReversed)))), + Util.qualifiedNameModuleName = (Just (Packaging.ModuleName (Strings.join "." (Lists.reverse restReversed)))), Util.qualifiedNameLocal = localName})))) -- | Restore the original trace from baseCx, while keeping the freshTypeVariableCount from newCx. Used between sibling sub-inferences (e.g. application LHS vs RHS) so that an error in the second sibling doesn't include the first sibling's trace path. Returns a new InferenceContext. @@ -175,5 +203,5 @@ unqualifyName :: Util.QualifiedName -> Core.Name unqualifyName qname = - let prefix = Optionals.cases (Util.qualifiedNameModuleName qname) "" (\n -> Strings.cat2 (Packaging.unModuleName n) ".") - in (Core.Name (Strings.cat2 prefix (Util.qualifiedNameLocal qname))) + let prefix = Optionals.cases (Util.qualifiedNameModuleName qname) "" (\n -> Strings.concat2 (Packaging.unModuleName n) ".") + in (Core.Name (Strings.concat2 prefix (Util.qualifiedNameLocal qname))) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs @@ -17,7 +17,7 @@ import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms import Hydra.Overlay.Haskell.Dsl.Terms (ToPrimName(..)) import qualified Hydra.Overlay.Haskell.Dsl.Types as Types -import qualified Hydra.Show.Core as ShowCore +import qualified Hydra.Print.Core as PrintCore import Data.Int import qualified Data.ByteString as B @@ -58,15 +58,6 @@ encode _cx g = ExtractCore.boolean g decode _cx = Right . Terms.boolean --- | Build a TypeScheme from type variables and a type --- Uses polyConstrained if there are any constraints, otherwise poly -buildTypeScheme :: [TypeVar] -> Type -> TypeScheme -buildTypeScheme vars typ = - let constraints = typeVarsToConstraints vars - in if L.null constraints - then Types.poly (typeVarNames vars) typ - else Types.polyConstrained (fmap (\tv -> (typeVarName tv, typeVarClasses tv)) vars) typ - instance IsString (TermCoder Term) where fromString = variable comparison :: TermCoder Comparison @@ -92,19 +83,6 @@ -- directly, e.g. @prim2 DefMath.add ...@) is defined in 'Hydra.Overlay.Haskell.Dsl.Terms' to avoid an import cycle -- and re-exported here for the registry/DSL modules. --- | Synthesize a minimal PrimitiveDefinition from a name and TypeScheme. --- Used by the prim0/prim1/prim2/prim3 helpers to bridge the kernel-shape change --- before the per-primitive metadata audit (description, isPure/isTotal exceptions, --- defaultImplementation) is performed. -defaultPrimitiveDefinition :: Name -> TypeScheme -> PrimitiveDefinition -defaultPrimitiveDefinition name typ = PrimitiveDefinition { - primitiveDefinitionName = name, - primitiveDefinitionSignature = typeSchemeToTermSignature typ, - primitiveDefinitionMetadata = Nothing, - primitiveDefinitionIsPure = True, - primitiveDefinitionIsTotal = True, - primitiveDefinitionDefaultImplementation = Nothing} - -- | Convert a TypeScheme to a TermSignature. A convenience alias for -- typeSchemeToTermSignature, used by primitive-declaration source modules. sig :: TypeScheme -> Typing.TermSignature @@ -171,7 +149,7 @@ function :: TermCoder x -> TermCoder y -> TermCoder (x -> y) function dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) encode decode where - encode cx _g term = Left $ otherErr cx $ "cannot encode term to a function: " ++ ShowCore.term term + encode cx _g term = Left $ otherErr cx $ "cannot encode term to a function: " ++ PrintCore.term term decode cx _val = Left $ otherErr cx "cannot decode functions to terms" -- | A graph-free TermCoder for function types (issue #446). Instead of calling the reducer to @@ -298,12 +276,6 @@ otherErr :: Typing.InferenceContext -> String -> Error.Error otherErr _cx msg = Error.ErrorOther (Error.OtherError msg) --- | A type variable specification with optional class constraints -data TypeVar = TypeVar { - typeVarName :: String, - typeVarClasses :: [Name] -} - pair :: TermCoder x -> TermCoder y -> TermCoder (x, y) pair xCoder yCoder = TermCoder (Types.pair (termCoderType xCoder) (termCoderType yCoder)) encode decode where @@ -313,50 +285,41 @@ yTerm <- termCoderDecode yCoder cx y return $ Terms.pair xTerm yTerm -prim0 :: ToPrimName n => n -> x -> [TypeVar] -> TermCoder x -> Primitive -prim0 n value vars output = Primitive (defaultPrimitiveDefinition name typ) impl +-- The prim0..prim3 registration helpers take the primitive's authoritative, translingual +-- 'PrimitiveDefinition' (from the generated Hydra.Lib.* modules, e.g. @DefMath.add@) and use its +-- signature verbatim as the single source of truth for the primitive's type — including class +-- constraints, parameter laziness, and metadata. The 'TermCoder' arguments now serve ONLY the +-- runtime marshalling of the implementation (term<->native encode/decode); their 'termCoderType' +-- no longer contributes to the primitive's declared type. This removes the former divergence risk +-- between the hand-written registration type and the generated definition (#566). + +prim0 :: PrimitiveDefinition -> x -> TermCoder x -> Primitive +prim0 def value output = Primitive def impl where - name = toPrimName n - typ = buildTypeScheme vars $ termCoderType output impl _g _args = termCoderDecode output primCx value -prim1 :: ToPrimName n => n -> (x -> y) -> [TypeVar] -> TermCoder x -> TermCoder y -> Primitive -prim1 n compute vars input1 output = Primitive (defaultPrimitiveDefinition name typ) impl +prim1 :: PrimitiveDefinition -> (x -> y) -> TermCoder x -> TermCoder y -> Primitive +prim1 def compute input1 output = Primitive def impl where - name = toPrimName n - typ = buildTypeScheme vars $ Types.functionMany [ - termCoderType input1, - termCoderType output] impl g args = do - ExtractCore.nArgs name 1 args + ExtractCore.nArgs (primitiveDefinitionName def) 1 args arg1 <- termCoderEncode input1 primCx g (args !! 0) termCoderDecode output primCx $ compute arg1 -prim2 :: ToPrimName n => n -> (x -> y -> z) -> [TypeVar] -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive -prim2 n compute vars input1 input2 output = Primitive (defaultPrimitiveDefinition name typ) impl +prim2 :: PrimitiveDefinition -> (x -> y -> z) -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive +prim2 def compute input1 input2 output = Primitive def impl where - name = toPrimName n - typ = buildTypeScheme vars $ Types.functionMany [ - termCoderType input1, - termCoderType input2, - termCoderType output] impl g args = do - ExtractCore.nArgs name 2 args + ExtractCore.nArgs (primitiveDefinitionName def) 2 args arg1 <- termCoderEncode input1 primCx g (args !! 0) arg2 <- termCoderEncode input2 primCx g (args !! 1) termCoderDecode output primCx $ compute arg1 arg2 -prim3 :: ToPrimName n => n -> (w -> x -> y -> z) -> [TypeVar] -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive -prim3 n compute vars input1 input2 input3 output = Primitive (defaultPrimitiveDefinition name typ) impl +prim3 :: PrimitiveDefinition -> (w -> x -> y -> z) -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive +prim3 def compute input1 input2 input3 output = Primitive def impl where - name = toPrimName n - typ = buildTypeScheme vars $ Types.functionMany [ - termCoderType input1, - termCoderType input2, - termCoderType input3, - termCoderType output] impl g args = do - ExtractCore.nArgs name 3 args + ExtractCore.nArgs (primitiveDefinitionName def) 3 args arg1 <- termCoderEncode input1 primCx g (args !! 0) arg2 <- termCoderEncode input2 primCx g (args !! 1) arg3 <- termCoderEncode input3 primCx g (args !! 2) @@ -380,15 +343,6 @@ encode _cx _g = Right decode _cx = Right --- | Get just the variable names from a list of TypeVars -typeVarNames :: [TypeVar] -> [String] -typeVarNames = fmap typeVarName - --- | Convert a list of TypeVars to the format needed by polyConstrained --- Filters out variables with no constraints -typeVarsToConstraints :: [TypeVar] -> [(String, [Name])] -typeVarsToConstraints = filter (not . L.null . snd) . fmap (\tv -> (typeVarName tv, typeVarClasses tv)) - type_ :: TermCoder Type type_ = TermCoder (TypeVariable _Type) encode decode where @@ -420,18 +374,6 @@ where encode _cx g = ExtractCore.uint8 g decode _cx = Right . Terms.uint8 - --- | Create an unconstrained type variable -v :: String -> TypeVar -v name = TypeVar name [] - --- | Create a type variable with Eq constraint -vEq :: String -> TypeVar -vEq name = TypeVar name [Name "equality"] - --- | Create a type variable with Ord constraint -vOrd :: String -> TypeVar -vOrd name = TypeVar name [Name "ordering"] variable :: String -> TermCoder Term variable v = TermCoder (Types.var v) encode decode diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs @@ -14,7 +14,7 @@ import Hydra.Overlay.Haskell.Dsl.Typed.Literals import qualified Hydra.Overlay.Haskell.Dsl.Annotations as Ann import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms -import qualified Hydra.Show.Core as ShowCore +import qualified Hydra.Print.Core as PrintCore import Hydra.Encoding (encodeBindingName) import Hydra.Decoding (decodeBindingName) @@ -57,7 +57,7 @@ fun @@ arg = apply (asTerm fun) (asTerm arg) (++) :: (AsTerm f String, AsTerm g String) => f -> g -> TypedTerm String -f ++ g = primitive2 (Prims.primName DefStrings.cat2) (asTerm f) (asTerm g) +f ++ g = primitive2 (Prims.primName DefStrings.concat2) (asTerm f) (asTerm g) -- | Field definition operator for records: name>: value -- Example: "name">: string "John" @@ -389,7 +389,7 @@ reify2 :: (TypedTerm a -> TypedTerm b -> TypedTerm c) -> TypedTerm (a -> b -> c) reify2 f = case (unTypedTerm $ f (var "x") (var "y")) of TermApplication (Application (TermApplication (Application lhs _)) _) -> TypedTerm lhs - t -> TypedTerm $ Terms.string $ "unexpected term as binary function: " <> ShowCore.term t + t -> TypedTerm $ Terms.string $ "unexpected term as binary function: " <> PrintCore.term t @@ -457,6 +457,29 @@ termSignatureParameters = zipWith (\i p -> if i `elem` idxs then p {parameterIsLazy = True} else p) [0..] (termSignatureParameters ts)} + +-- | Convert a TypeScheme to a TermSignature, replacing the synthesized @arg0, arg1, ...@ parameter +-- names and empty descriptions with an authored @(name, description)@ pair per value parameter. +-- Arity-checked: fails immediately if the number of pairs does not match the number of value +-- parameters peeled from the type (this catches signature/name drift at DSL-load time). +-- Example: sigWithParams [("x", "the value to compare"), ("y", "the value to compare against")] $ +-- TypeScheme [Name "x"] (tx ~> tx ~> boolean) Nothing +sigWithParams :: [(String, String)] -> TypeScheme -> TermSignature +sigWithParams pairs ts = + let s = sig ts + params = termSignatureParameters s + n = L.length params + m = L.length pairs + in if m /= n + then error (L.concat ["sigWithParams: ", show m, " (name, description) pair(s) provided for a ", + show n, "-parameter signature"]) + else s { + termSignatureParameters = + zipWith + (\p (nm, desc) -> p { + parameterName = Name nm, + parameterDescription = if L.null desc then Nothing else Just desc}) + params pairs} -- | Build the entity metadata for a primitive from its (always-present) one-line description and -- long-form comments. Each comments element is one logical observation, kept distinct rather than concatenated. diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs @@ -28,6 +28,7 @@ import qualified Hydra.Overlay.Haskell.Dsl.Typed.Terms as MetaTerms import Hydra.Overlay.Haskell.Dsl.Terms (ToPrimName) import qualified Hydra.Overlay.Haskell.Dsl.Typed.Types as T +import qualified Data.Set as S import qualified Hydra.Dsl.Validation as Validation import qualified Data.Int as I @@ -39,6 +40,7 @@ tag_disabled = Tag "disabled" tag_disabledForMinimalInference = Tag "disabledForMinimalInference" +tag_disabledForScala = Tag "disabledForScala" alphaConvertRef :: TypedTerm (Name -> Name -> Term -> Term) alphaConvertRef = TypedTerm $ TermVariable $ Name "hydra.reduction.alphaConvert" @@ -77,6 +79,12 @@ checkPackageNameConventionRef :: TypedTerm (Package -> Maybe InvalidPackageError) checkPackageNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkPackageNameConvention" +checkUndeclaredDependenciesRef :: TypedTerm (M.Map Name ModuleName -> S.Set Name -> Module -> [InvalidPackageError]) +checkUndeclaredDependenciesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkUndeclaredDependencies" + +undeclaredDependencyOwnersRef :: TypedTerm ([Module] -> M.Map Name ModuleName) +undeclaredDependencyOwnersRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.undeclaredDependencyOwners" + -- | Type checking test: infers the type and compares with expected. checkTest :: String -> [Tag] -> TypedTerm Term -> TypedTerm Term -> TypedTerm Type -> TypedTerm TestCaseWithMetadata checkTest name tags input _outputTerm outputType = testCaseWithMetadata (Phantoms.string name) @@ -146,7 +154,7 @@ (testCaseUniversal $ universalTestCase (retype $ Eithers.either (Phantoms.lambda "e" (Phantoms.string "FAIL")) - (Phantoms.lambda "result" (Strings.cat2 (Phantoms.string "unexpected: ") + (Phantoms.lambda "result" (Strings.concat2 (Phantoms.string "unexpected: ") (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result"))))) (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) (Phantoms.string "FAIL")) @@ -160,7 +168,7 @@ infTest name tags term ts = testCaseWithMetadata (Phantoms.string name) (testCaseUniversal $ universalTestCase (retype $ Eithers.either - (Phantoms.lambda "e" (Strings.cat2 (Phantoms.string "INFERENCE ERROR: ") (Phantoms.string "failed"))) + (Phantoms.lambda "e" (Strings.concat2 (Phantoms.string "INFERENCE ERROR: ") (Phantoms.string "failed"))) (Phantoms.lambda "result" (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result")))) (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) @@ -226,22 +234,22 @@ removeTypesFromTermRef = TypedTerm $ TermVariable $ Name "hydra.strip.removeTypesFromTerm" showInvalidModuleErrorRef :: TypedTerm (InvalidModuleError -> String) -showInvalidModuleErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidModuleError" +showInvalidModuleErrorRef = TypedTerm $ TermVariable $ Name "hydra.print.error.packaging.invalidModuleError" showInvalidPackageErrorRef :: TypedTerm (InvalidPackageError -> String) -showInvalidPackageErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidPackageError" +showInvalidPackageErrorRef = TypedTerm $ TermVariable $ Name "hydra.print.error.packaging.invalidPackageError" showInvalidTermErrorRef :: TypedTerm (InvalidTermError -> String) -showInvalidTermErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.core.invalidTermError" +showInvalidTermErrorRef = TypedTerm $ TermVariable $ Name "hydra.print.error.core.invalidTermError" showTermRef :: TypedTerm (Term -> String) -showTermRef = TypedTerm $ TermVariable $ Name "hydra.show.core.term" +showTermRef = TypedTerm $ TermVariable $ Name "hydra.print.core.term" showTypeRef :: TypedTerm (Type -> String) -showTypeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.type" +showTypeRef = TypedTerm $ TermVariable $ Name "hydra.print.core.type" showTypeSchemeRef :: TypedTerm (TypeScheme -> String) -showTypeSchemeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.typeScheme" +showTypeSchemeRef = TypedTerm $ TermVariable $ Name "hydra.print.core.typeScheme" -- | evalPair for String-typed expressions (identity show) stringEvalPair :: String -> TypedTerm String -> TypedTerm String -> TypedTerm TestCaseWithMetadata @@ -270,9 +278,12 @@ typeSchemeToFTypeRef = TypedTerm $ TermVariable $ Name "hydra.scoping.typeSchemeToFType" universalCase :: String -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata -universalCase cname actual expected = testCaseWithMetadata (Phantoms.string cname) +universalCase cname actual expected = universalCaseWithTags cname [] actual expected + +universalCaseWithTags :: String -> [Tag] -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata +universalCaseWithTags cname tags actual expected = testCaseWithMetadata (Phantoms.string cname) (testCaseUniversal $ universalTestCase (retype actual) (retype expected)) - nothing noTags + nothing (Phantoms.list $ tag . unTag <$> tags) where retype :: TypedTerm x -> TypedTerm String retype (TypedTerm t) = TypedTerm t @@ -333,14 +344,14 @@ -- for module-level findings. showValidationResultModule :: TypedTerm (ValidationResult InvalidModuleError) -> TypedTerm String showValidationResultModule vr = retype $ - Strings.cat2 - (Strings.cat2 (Phantoms.string "errors=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + Strings.concat2 + (Strings.concat2 (Phantoms.string "errors=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "e" $ showInvalidModuleErrorRef @@ Phantoms.var "e") (Validation.validationResultErrors vr)) (Phantoms.string "]")) - (Strings.cat2 (Phantoms.string " warnings=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + (Strings.concat2 (Phantoms.string " warnings=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "w" $ showInvalidModuleErrorRef @@ Phantoms.var "w") (Validation.validationResultWarnings vr)) (Phantoms.string "]")) @@ -352,14 +363,14 @@ -- counterpart of 'showValidationResultTerm'. showValidationResultPackage :: TypedTerm (ValidationResult InvalidPackageError) -> TypedTerm String showValidationResultPackage vr = retype $ - Strings.cat2 - (Strings.cat2 (Phantoms.string "errors=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + Strings.concat2 + (Strings.concat2 (Phantoms.string "errors=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "e" $ showInvalidPackageErrorRef @@ Phantoms.var "e") (Validation.validationResultErrors vr)) (Phantoms.string "]")) - (Strings.cat2 (Phantoms.string " warnings=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + (Strings.concat2 (Phantoms.string " warnings=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "w" $ showInvalidPackageErrorRef @@ Phantoms.var "w") (Validation.validationResultWarnings vr)) (Phantoms.string "]")) @@ -409,14 +420,14 @@ -- 'ValidationResult' values in profile-aware test cases. showValidationResultTerm :: TypedTerm (ValidationResult InvalidTermError) -> TypedTerm String showValidationResultTerm vr = retype $ - Strings.cat2 - (Strings.cat2 (Phantoms.string "errors=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + Strings.concat2 + (Strings.concat2 (Phantoms.string "errors=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "e" $ showInvalidTermErrorRef @@ Phantoms.var "e") (Validation.validationResultErrors vr)) (Phantoms.string "]")) - (Strings.cat2 (Phantoms.string " warnings=[") $ - Strings.cat2 (Strings.intercalate (Phantoms.string ";") $ + (Strings.concat2 (Phantoms.string " warnings=[") $ + Strings.concat2 (Strings.join (Phantoms.string ";") $ Lists.map (Phantoms.lambda "w" $ showInvalidTermErrorRef @@ Phantoms.var "w") (Validation.validationResultWarnings vr)) (Phantoms.string "]")) @@ -519,7 +530,7 @@ validateCoreTermCase :: String -> TypedTerm Bool -> TypedTerm Term -> TypedTerm (Maybe InvalidTermError) -> TypedTerm TestCaseWithMetadata validateCoreTermCase cname typed input expected = universalCase cname (retype $ Optionals.cases - (Lists.maybeHead $ Validation.validationResultErrors $ + (Lists.head $ Validation.validationResultErrors $ validateCoreTermProfiledRef @@ kernelDefaultCoreProfileRef @@ typed @@ testGraphRef @@ input) (Phantoms.string "valid") (Phantoms.lambda "e" (showInvalidTermErrorRef @@ Phantoms.var "e"))) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs @@ -6,9 +6,17 @@ import qualified Data.Char as C +-- | Check whether a character is alphabetic. +isAlpha :: Int -> Bool +isAlpha = C.isAlpha . C.chr + -- | Check whether a character is alphanumeric. isAlphaNum :: Int -> Bool isAlphaNum = C.isAlphaNum . C.chr + +-- | Check whether a character is an ASCII decimal digit. +isDigit :: Int -> Bool +isDigit = C.isDigit . C.chr -- | Check whether a character is lowercase. isLower :: Int -> Bool diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs @@ -3,6 +3,7 @@ module Hydra.Overlay.Haskell.Lib.Effects where import qualified Control.Monad as CM +import qualified Data.Set as S import Prelude hiding (foldl, map, pure) import qualified Prelude as P @@ -19,6 +20,10 @@ compose :: (a -> IO b) -> (b -> IO c) -> a -> IO c compose f g = \x -> f x P.>>= g +-- | Left-fold over a list with an effect-returning function. (Alias of foldl.) +foldList :: (a -> b -> IO a) -> a -> [b] -> IO a +foldList = CM.foldM + -- | Left-fold over a list with an effect-returning function. foldl :: (a -> b -> IO a) -> a -> [b] -> IO a foldl = CM.foldM @@ -34,6 +39,10 @@ -- | Map an effect-returning function over an optional. mapOptional :: (a -> IO b) -> Maybe a -> IO (Maybe b) mapOptional = CM.mapM + +-- | Map an effect-returning function over a set. +mapSet :: Ord b => (a -> IO b) -> S.Set a -> IO (S.Set b) +mapSet f s = P.fmap S.fromList (CM.mapM f (S.toList s)) -- | Lift a pure value into an effect. pure :: a -> IO a diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs @@ -2,12 +2,17 @@ module Hydra.Overlay.Haskell.Lib.Eithers where +import Prelude hiding (either, map, pure) import qualified Control.Monad as CM import qualified Data.Bifunctor as BF import qualified Data.Either as E import qualified Data.Set as S +-- | Applicative apply for Either: combine a function under Either and an argument under Either. +apply :: Either a (b -> c) -> Either a b -> Either a c +apply ef ex = bind ef (\f -> map f ex) + -- | Map over both sides of an Either value. bimap :: (a -> c) -> (b -> d) -> Either a b -> Either c d bimap = BF.bimap @@ -16,21 +21,17 @@ bind :: Either a b -> (b -> Either a c) -> Either a c bind = (>>=) +-- | Kleisli composition for Either. +compose :: (a -> Either e b) -> (b -> Either e c) -> a -> Either e c +compose f g x = bind (f x) g + -- | Eliminate an Either value by applying one of two functions. either :: (a -> c) -> (b -> c) -> Either a b -> c either = E.either -- | Left-fold over a list with an Either-returning function, short-circuiting on Left. -foldl :: (a -> b -> Either c a) -> a -> [b] -> Either c a -foldl = CM.foldM - --- | Extract the Left value, or return a default. -fromLeft :: a -> Either a b -> a -fromLeft = E.fromLeft - --- | Extract the Right value, or return a default. -fromRight :: b -> Either a b -> b -fromRight = E.fromRight +foldList :: (a -> b -> Either c a) -> a -> [b] -> Either c a +foldList = CM.foldM -- | Check if an Either is a Left value. isLeft :: Either a b -> Bool @@ -61,8 +62,12 @@ mapSet f s = fmap S.fromList (CM.mapM f (S.toList s)) -- | Partition a list of Eithers into lefts and rights. -partitionEithers :: [Either a b] -> ([a], [b]) -partitionEithers = E.partitionEithers +partition :: [Either a b] -> ([a], [b]) +partition = E.partitionEithers + +-- | Wrap a value as a Right. +pure :: b -> Either a b +pure = Right -- | Extract all Right values from a list of Eithers. rights :: [Either a b] -> [b] diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs @@ -2,46 +2,11 @@ module Hydra.Overlay.Haskell.Lib.Equality where -import Hydra.Util -import Data.Int - - --- | Compare two values and return a Comparison. -compare :: Ord a => a -> a -> Comparison -compare x y - | x < y = ComparisonLessThan - | x > y = ComparisonGreaterThan - | otherwise = ComparisonEqualTo - -- | Check if two values are equal. equal :: Eq a => a -> a -> Bool equal = (==) --- | Check if first value is greater than second. -gt :: Ord a => a -> a -> Bool -gt = (>) - --- | Check if first value is greater than or equal to second. -gte :: Ord a => a -> a -> Bool -gte = (>=) - --- | Return a value unchanged. -identity :: a -> a -identity = id - --- | Check if first value is less than second. -lt :: Ord a => a -> a -> Bool -lt = (<) - --- | Check if first value is less than or equal to second. -lte :: Ord a => a -> a -> Bool -lte = (<=) - --- | Return the maximum of two values. -max :: Ord a => a -> a -> a -max = Prelude.max - --- | Return the minimum of two values. -min :: Ord a => a -> a -> a -min = Prelude.min +-- | Check if two values are unequal. +notEqual :: Eq a => a -> a -> Bool +notEqual = (/=) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Functions.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Functions.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Functions.hs @@ -0,0 +1,22 @@ +-- | Haskell implementations of hydra.lib.functions primitives. + +module Hydra.Overlay.Haskell.Lib.Functions where + +import qualified Prelude as P + + +-- | Compose two functions: compose g f x = g (f x). +compose :: (b -> c) -> (a -> b) -> a -> c +compose g f = \x -> g (f x) + +-- | Return the first argument, ignoring the second. +const :: a -> b -> a +const x _ = x + +-- | Swap the argument order of a binary function. +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +-- | Return the argument unchanged. +identity :: a -> a +identity = P.id diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Hashing.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Hashing.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Hashing.hs @@ -0,0 +1,16 @@ +-- | Haskell implementations of hydra.lib.hashing primitives + +module Hydra.Overlay.Haskell.Lib.Hashing where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Digest.Pure.SHA as SHA + + +-- | Compute the SHA-256 digest of a sequence of bytes, returning the 32-byte digest. +sha256 :: BS.ByteString -> BS.ByteString +sha256 = BL.toStrict . SHA.bytestringDigest . SHA.sha256 . BL.fromStrict + +-- | Compute the SHA-256 digest of a sequence of bytes as a 64-character lowercase hex string. +sha256Hex :: BS.ByteString -> String +sha256Hex = SHA.showDigest . SHA.sha256 . BL.fromStrict diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs @@ -2,22 +2,35 @@ module Hydra.Overlay.Haskell.Lib.Lists where +import Prelude hiding (compose, head, init, last, map, pure, tail, takeWhile) import Hydra.Util import Hydra.Core import Hydra.Graph import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms +import qualified Control.Monad as CM import qualified Data.List as L +import qualified Data.Set as S -- | Apply a list of functions to a list of values (applicative style). apply :: [a -> b] -> [a] -> [b] apply = (<*>) +-- | Return the element at the given index, or Nothing if out of bounds. (Alias of maybeAt.) +at :: Int -> [a] -> Maybe a +at i l + | i < 0 || i >= L.length l = Nothing + | otherwise = Just (l !! i) + -- | Apply a function that returns lists to each element and flatten results. bind :: [a] -> (a -> [b]) -> [b] bind = (>>=) +-- | Compose two list-returning functions (Kleisli composition in the list monad). +compose :: (a -> [b]) -> (b -> [c]) -> a -> [c] +compose f g x = f x >>= g + -- | Concatenate a list of lists. concat :: [[a]] -> [a] concat = L.concat @@ -30,6 +43,10 @@ cons :: a -> [a] -> [a] cons = (:) +-- | Remove duplicate elements from a list. (Alias of nub.) +distinct :: Eq a => [a] -> [a] +distinct = L.nub + -- | Drop the first n elements from a list. drop :: Int -> [a] -> [a] drop = L.drop @@ -38,10 +55,6 @@ dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile = L.dropWhile --- | Check if an element is in a list. -elem :: Eq a => a -> [a] -> Bool -elem = L.elem - -- | Filter a list based on a predicate. filter :: (a -> Bool) -> [a] -> [a] filter = L.filter @@ -50,6 +63,10 @@ find :: (a -> Bool) -> [a] -> Maybe a find = L.find +-- | Left-fold a list in the list monad (a nondeterministic fold). +foldList :: (a -> b -> [a]) -> a -> [b] -> [a] +foldList = CM.foldM + -- | Fold a list from the left. -- Strict left fold. Lazy foldl can pile up thunks for accumulator types -- that are field-update records (e.g. PythonModuleMetadata in @@ -67,10 +84,20 @@ group :: Eq a => [a] -> [[a]] group = L.group --- | Intercalate a list of lists with a separator list between each. -intercalate :: [a] -> [[a]] -> [a] -intercalate = L.intercalate +-- | Return the first element, or Nothing if the list is empty. (Alias of maybeHead.) +head :: [a] -> Maybe a +head [] = Nothing +head (x:_) = Just x +-- | Return all elements except the last, or Nothing if the list is empty. (Alias of maybeInit.) +init :: [a] -> Maybe [a] +init [] = Nothing +init xs = Just (L.init xs) + +-- | Intercalate a list of lists with a separator list between each. (Alias of intercalate.) +join :: [a] -> [[a]] -> [a] +join = L.intercalate + -- | Intersperse a value between elements of a list. intersperse :: a -> [a] -> [a] intersperse = L.intersperse @@ -83,35 +110,26 @@ map :: (a -> b) -> [a] -> [b] map = fmap --- | Get the element at a specified index in a list, returning Nothing if out of bounds. -maybeAt :: Int -> [a] -> Maybe a -maybeAt i l - | i < 0 || i >= L.length l = Nothing - | otherwise = Just (l !! i) - --- | Get the first element of a list, returning Nothing if the list is empty. -maybeHead :: [a] -> Maybe a -maybeHead [] = Nothing -maybeHead (x:_) = Just x +-- | Traverse a list in the list monad. +mapList :: (a -> [b]) -> [a] -> [[b]] +mapList = CM.mapM --- | Return all elements except the last one, returning Nothing if the list is empty. -maybeInit :: [a] -> Maybe [a] -maybeInit [] = Nothing -maybeInit xs = Just (L.init xs) +-- | Traverse an optional value in the list monad. +mapOptional :: (a -> [b]) -> Maybe a -> [Maybe b] +mapOptional = traverse --- | Get the last element of a list, returning Nothing if the list is empty. -maybeLast :: [a] -> Maybe a -maybeLast [] = Nothing -maybeLast xs = Just (L.last xs) +-- | Traverse a set in the list monad. +mapSet :: Ord b => (a -> [b]) -> S.Set a -> [S.Set b] +mapSet f s = fmap S.fromList (CM.mapM f (S.toList s)) --- | Get all elements of a list except the first, returning Nothing if the list is empty. -maybeTail :: [a] -> Maybe [a] -maybeTail [] = Nothing -maybeTail (_:xs) = Just xs +-- | Return the last element, or Nothing if the list is empty. (Alias of maybeLast.) +last :: [a] -> Maybe a +last [] = Nothing +last xs = Just (L.last xs) --- | Remove duplicate elements from a list. -nub :: Eq a => [a] -> [a] -nub = L.nub +-- | Test whether an element is in a list. (Alias of elem.) +member :: Eq a => a -> [a] -> Bool +member = L.elem -- | Check if a list is empty. null :: [a] -> Bool @@ -141,17 +159,26 @@ sort :: Ord a => [a] -> [a] sort = L.sort --- | Sort a list based on a key function. -sortOn :: Ord b => (a -> b) -> [a] -> [a] -sortOn = L.sortOn +-- | Sort a list based on a key function. (Alias of sortOn.) +sortBy :: Ord b => (a -> b) -> [a] -> [a] +sortBy = L.sortOn -- | Split a list at the first element where predicate fails. span :: (a -> Bool) -> [a] -> ([a], [a]) span = L.span +-- | Return all elements except the first, or Nothing if the list is empty. (Alias of maybeTail.) +tail :: [a] -> Maybe [a] +tail [] = Nothing +tail (_:xs) = Just xs + -- | Take the first n elements from a list. take :: Int -> [a] -> [a] take = L.take + +-- | Take elements from the beginning of a list while a predicate holds. +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile = L.takeWhile -- | Transpose a list of lists. transpose :: [[a]] -> [[a]] diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs @@ -66,8 +66,8 @@ decimalToFloat64 = toRealFloat -- | Convert binary to string by base64 encoding. -binaryToString :: B.ByteString -> String -binaryToString = T.unpack . TE.decodeUtf8 . B64.encode +binaryToBase64 :: B.ByteString -> String +binaryToBase64 = T.unpack . TE.decodeUtf8 . B64.encode -- | Convert a float32 (Float) to a decimal (Scientific). float32ToDecimal :: Float -> Scientific @@ -116,8 +116,8 @@ readBigint s = readMaybe s :: Maybe Integer -- | Parse a string to a boolean. -readBoolean :: String -> Maybe Bool -readBoolean s = if s == "true" then Just True +parseBoolean :: String -> Maybe Bool +parseBoolean s = if s == "true" then Just True else if s == "false" then Just False else Nothing @@ -154,8 +154,8 @@ readInt64 s = readMaybe s :: Maybe Int64 -- | Parse a string literal. -readString :: String -> Maybe String -readString s = readMaybe s :: Maybe String +parseString :: String -> Maybe String +parseString s = readMaybe s :: Maybe String -- Note: Hydra uses wider signed types to represent unsigned values without overflow -- Uint8 -> Int16, Uint16 -> Int, Uint32 -> Int64, Uint64 -> Integer @@ -190,8 +190,8 @@ showBigint = show -- | Convert a boolean to string. -showBoolean :: Bool -> String -showBoolean b = case b of +printBoolean :: Bool -> String +printBoolean b = case b of True -> "true" False -> "false" @@ -226,8 +226,8 @@ showInt64 = show -- | Convert a string to a quoted string representation. -showString :: String -> String -showString = show +printString :: String -> String +printString = show -- | Convert a uint8 to string. showUint8 :: Int16 -> String @@ -247,8 +247,8 @@ -- | Convert string to binary by base64 decoding. -- Returns an empty ByteString if decoding fails. -stringToBinary :: String -> B.ByteString -stringToBinary s = case B64.decode (TE.encodeUtf8 $ T.pack s) of +base64ToBinary :: String -> B.ByteString +base64ToBinary s = case B64.decode (TE.encodeUtf8 $ T.pack s) of Left _ -> B.empty Right bs -> bs diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs @@ -17,6 +17,10 @@ delete :: Ord k => k -> M.Map k v -> M.Map k v delete = M.delete +-- | Compute the difference of two maps by key. +difference :: Ord k => M.Map k v -> M.Map k v -> M.Map k v +difference = M.difference + -- | Get the values of a map. elems :: M.Map k v -> [v] elems = M.elems @@ -45,6 +49,10 @@ insert :: Ord k => k -> v -> M.Map k v -> M.Map k v insert = M.insert +-- | Compute the intersection of two maps by key (values from the first map). +intersection :: Ord k => M.Map k v -> M.Map k v -> M.Map k v +intersection = M.intersection + -- | Get the keys of a map. keys :: M.Map k v -> [k] keys = M.keys @@ -84,3 +92,7 @@ -- | Union two maps, with the first taking precedence. union :: Ord k => M.Map k v -> M.Map k v -> M.Map k v union = M.union + +-- | Compute the left-biased union of a list of maps. +unions :: Ord k => [M.Map k v] -> M.Map k v +unions = M.unions diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs @@ -1,9 +1,11 @@ -- | Haskell implementations of hydra.lib.math primitives +{-# LANGUAGE RankNTypes #-} module Hydra.Overlay.Haskell.Lib.Math where -import Prelude (Num, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), (.), ($), (+), (-), (*), (==), (||)) +import Prelude (Num, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), String, (.), ($), (+), (-), (*), (==), (||)) import qualified Prelude +import qualified Hydra.Core as Core -- | Return the absolute value. @@ -96,23 +98,15 @@ logBase :: Double -> Double -> Double logBase = Prelude.logBase --- | Return the maximum of two values. -max :: Ord a => a -> a -> a -max = Prelude.max - -- | Divide two integers using integer division, returning Nothing on division by zero. -maybeDiv :: Int -> Int -> Maybe Int -maybeDiv _ 0 = Nothing -maybeDiv x y = Just (Prelude.div x y) - --- | Return the minimum of two values. -min :: Ord a => a -> a -> a -min = Prelude.min +div :: Int -> Int -> Maybe Int +div _ 0 = Nothing +div x y = Just (Prelude.div x y) -- | Mathematical modulo, returning Nothing on division by zero. -maybeMod :: Int -> Int -> Maybe Int -maybeMod _ 0 = Nothing -maybeMod x y = Just (Prelude.mod x y) +mod :: Int -> Int -> Maybe Int +mod _ 0 = Nothing +mod x y = Just (Prelude.mod x y) -- | Multiply two numbers. mul :: Num a => a -> a -> a @@ -142,20 +136,14 @@ pow :: Double -> Double -> Double pow = (Prelude.**) --- | Return the predecessor (x - 1), returning Nothing on int32 minBound. -maybePred :: Int -> Maybe Int -maybePred x - | x == (-2147483648) = Nothing - | Prelude.otherwise = Just (x - 1) - -- | Generate a range of values from start to end (inclusive). range :: Enum a => a -> a -> [a] range start end = [start .. end] -- | Integer remainder, returning Nothing on division by zero. -maybeRem :: Int -> Int -> Maybe Int -maybeRem _ 0 = Nothing -maybeRem x y = Just (Prelude.rem x y) +rem :: Int -> Int -> Maybe Int +rem _ 0 = Nothing +rem x y = Just (Prelude.rem x y) -- | Return x rounded to the nearest integer, as a float. -- @@ -210,11 +198,6 @@ subFloat64 :: Double -> Double -> Double subFloat64 = sub --- | Return the successor (x + 1), returning Nothing on int32 maxBound. -maybeSucc :: Int -> Maybe Int -maybeSucc x - | x == 2147483647 = Nothing - | Prelude.otherwise = Just (x + 1) -- | Return the tangent of x radians. tan :: Double -> Double @@ -232,3 +215,91 @@ truncate x | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x | Prelude.otherwise = Prelude.fromIntegral (Prelude.truncate x :: Integer) + +-- Constraint-polymorphic ('numeric') arithmetic over raw terms. +-- +-- These implementations back the polymorphic add/sub/mul/negate primitives, which are +-- registered with identity (Term) coders (see Hydra.Overlay.Haskell.Libraries) so that the +-- runtime numeric type is discovered by dispatching on the argument's literal variant. Each +-- variant delegates to Haskell's Num instance for the underlying representation type, which +-- gives the correct per-type semantics for free: two's-complement wraparound for the +-- fixed-width integer types, arbitrary precision for bigint, and IEEE 754 for the floats. +-- +-- Type inference guarantees both operands of a binary op share one 'numeric' type, so the +-- dispatch keys on the first operand and requires the second to match; a mismatch or a +-- non-numeric literal is an internal invariant violation and fails loudly. + +-- | Apply a Num-polymorphic binary operation to two numeric terms, dispatching on the runtime +-- integer/float variant. +numericBinary :: String -> (forall a. Num a => a -> a -> a) -> Core.Term -> Core.Term -> Core.Term +numericBinary opName op x y = case (numericLiteral opName x, numericLiteral opName y) of + (Core.LiteralInteger ix, Core.LiteralInteger iy) -> + Core.TermLiteral $ Core.LiteralInteger $ integerBinary opName op ix iy + (Core.LiteralFloat fx, Core.LiteralFloat fy) -> + Core.TermLiteral $ Core.LiteralFloat $ floatBinary opName op fx fy + _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": operands are not the same numeric kind" + +-- | Apply a Num-polymorphic unary operation to a numeric term. +numericUnary :: String -> (forall a. Num a => a -> a) -> Core.Term -> Core.Term +numericUnary opName op x = case numericLiteral opName x of + Core.LiteralInteger ix -> Core.TermLiteral $ Core.LiteralInteger $ integerUnary op ix + Core.LiteralFloat fx -> Core.TermLiteral $ Core.LiteralFloat $ floatUnary op fx + _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": operand is not numeric" + +-- | Extract the literal from a term, failing loudly on any non-literal term. +numericLiteral :: String -> Core.Term -> Core.Literal +numericLiteral opName term = case term of + Core.TermLiteral lit -> lit + _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": expected a literal term" + +integerBinary :: String -> (forall a. Num a => a -> a -> a) -> Core.IntegerValue -> Core.IntegerValue -> Core.IntegerValue +integerBinary opName op ix iy = case (ix, iy) of + (Core.IntegerValueBigint a, Core.IntegerValueBigint b) -> Core.IntegerValueBigint (op a b) + (Core.IntegerValueInt8 a, Core.IntegerValueInt8 b) -> Core.IntegerValueInt8 (op a b) + (Core.IntegerValueInt16 a, Core.IntegerValueInt16 b) -> Core.IntegerValueInt16 (op a b) + (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) -> Core.IntegerValueInt32 (op a b) + (Core.IntegerValueInt64 a, Core.IntegerValueInt64 b) -> Core.IntegerValueInt64 (op a b) + (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) -> Core.IntegerValueUint8 (op a b) + (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) -> Core.IntegerValueUint16 (op a b) + (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) -> Core.IntegerValueUint32 (op a b) + (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) -> Core.IntegerValueUint64 (op a b) + _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": integer operands differ in precision" + +integerUnary :: (forall a. Num a => a -> a) -> Core.IntegerValue -> Core.IntegerValue +integerUnary op iv = case iv of + Core.IntegerValueBigint a -> Core.IntegerValueBigint (op a) + Core.IntegerValueInt8 a -> Core.IntegerValueInt8 (op a) + Core.IntegerValueInt16 a -> Core.IntegerValueInt16 (op a) + Core.IntegerValueInt32 a -> Core.IntegerValueInt32 (op a) + Core.IntegerValueInt64 a -> Core.IntegerValueInt64 (op a) + Core.IntegerValueUint8 a -> Core.IntegerValueUint8 (op a) + Core.IntegerValueUint16 a -> Core.IntegerValueUint16 (op a) + Core.IntegerValueUint32 a -> Core.IntegerValueUint32 (op a) + Core.IntegerValueUint64 a -> Core.IntegerValueUint64 (op a) + +floatBinary :: String -> (forall a. Num a => a -> a -> a) -> Core.FloatValue -> Core.FloatValue -> Core.FloatValue +floatBinary opName op fx fy = case (fx, fy) of + (Core.FloatValueFloat32 a, Core.FloatValueFloat32 b) -> Core.FloatValueFloat32 (op a b) + (Core.FloatValueFloat64 a, Core.FloatValueFloat64 b) -> Core.FloatValueFloat64 (op a b) + _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": float operands differ in precision" + +floatUnary :: (forall a. Num a => a -> a) -> Core.FloatValue -> Core.FloatValue +floatUnary op fv = case fv of + Core.FloatValueFloat32 a -> Core.FloatValueFloat32 (op a) + Core.FloatValueFloat64 a -> Core.FloatValueFloat64 (op a) + +-- | Polymorphic addition over numeric terms. +addTerm :: Core.Term -> Core.Term -> Core.Term +addTerm = numericBinary "add" (+) + +-- | Polymorphic subtraction over numeric terms. +subTerm :: Core.Term -> Core.Term -> Core.Term +subTerm = numericBinary "sub" (-) + +-- | Polymorphic multiplication over numeric terms. +mulTerm :: Core.Term -> Core.Term -> Core.Term +mulTerm = numericBinary "mul" (*) + +-- | Polymorphic negation over numeric terms. +negateTerm :: Core.Term -> Core.Term +negateTerm = numericUnary "negate" Prelude.negate diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs @@ -2,7 +2,10 @@ module Hydra.Overlay.Haskell.Lib.Optionals where +import Prelude hiding (map, pure) +import qualified Control.Monad as CM import qualified Data.Maybe as Y +import qualified Data.Set as S -- | Apply a function to an argument (applicative). @@ -17,18 +20,18 @@ cases :: Y.Maybe a -> b -> (a -> b) -> b cases m n j = Y.maybe n j m --- | Filter out absent values from a list. -cat :: [Y.Maybe a] -> [a] -cat = Y.catMaybes - -- | Compose two optional-returning functions (Kleisli composition). compose :: (a -> Y.Maybe b) -> (b -> Y.Maybe c) -> (a -> Y.Maybe c) compose f g = \x -> f x >>= g --- | Get a value from an optional value, or return a default value. -fromOptional :: a -> Y.Maybe a -> a -fromOptional = Y.fromMaybe +-- | Left-fold over a list with an optional-returning function, short-circuiting on none. +foldList :: (a -> b -> Y.Maybe a) -> a -> [b] -> Y.Maybe a +foldList = CM.foldM +-- | Filter out absent values from a list. +givens :: [Y.Maybe a] -> [a] +givens = Y.catMaybes + -- | Check if a value is present. isGiven :: Y.Maybe a -> Bool isGiven = Y.isJust @@ -41,10 +44,18 @@ map :: (a -> b) -> Y.Maybe a -> Y.Maybe b map = fmap +-- | Traverse a list in the optional monad. +mapList :: (a -> Y.Maybe b) -> [a] -> Y.Maybe [b] +mapList = CM.mapM + -- | Map a function over a list and collect present results. mapOptional :: (a -> Y.Maybe b) -> [a] -> [b] mapOptional = Y.mapMaybe +-- | Traverse a set in the optional monad. +mapSet :: Ord b => (a -> Y.Maybe b) -> S.Set a -> Y.Maybe (S.Set b) +mapSet f s = fmap S.fromList (CM.mapM f (S.toList s)) + -- | Lift a value into the optional type. pure :: a -> Y.Maybe a pure = Just @@ -52,3 +63,7 @@ -- | Convert an optional value to a list: a present value becomes [x], an absent value becomes []. toList :: Y.Maybe a -> [a] toList = Y.maybeToList + +-- | Get a value from an optional value, or return a default value. +withDefault :: a -> Y.Maybe a -> a +withDefault = Y.fromMaybe diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Ordering.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Ordering.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Ordering.hs @@ -0,0 +1,37 @@ +-- | Haskell implementations of hydra.lib.ordering primitives. + +module Hydra.Overlay.Haskell.Lib.Ordering where + +import Hydra.Util + + +-- | Compare two values and return a Comparison. +compare :: Ord a => a -> a -> Comparison +compare x y + | x < y = ComparisonLessThan + | x > y = ComparisonGreaterThan + | otherwise = ComparisonEqualTo + +-- | Check if first value is greater than second. +gt :: Ord a => a -> a -> Bool +gt = (>) + +-- | Check if first value is greater than or equal to second. +gte :: Ord a => a -> a -> Bool +gte = (>=) + +-- | Check if first value is less than second. +lt :: Ord a => a -> a -> Bool +lt = (<) + +-- | Check if first value is less than or equal to second. +lte :: Ord a => a -> a -> Bool +lte = (<=) + +-- | Return the maximum of two values. +max :: Ord a => a -> a -> a +max = Prelude.max + +-- | Return the minimum of two values. +min :: Ord a => a -> a -> a +min = Prelude.min diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs @@ -2,6 +2,7 @@ module Hydra.Overlay.Haskell.Lib.Sets where +import Prelude hiding (filter) import qualified Data.Set as S @@ -16,6 +17,10 @@ -- | Create an empty set. empty :: S.Set x empty = S.empty + +-- | Filter a set by a predicate. +filter :: Ord x => (x -> Bool) -> S.Set x -> S.Set x +filter = S.filter -- | Create a set from a list. fromList :: Ord x => [x] -> S.Set x diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs @@ -2,36 +2,37 @@ module Hydra.Overlay.Haskell.Lib.Strings where +import Prelude hiding (concat, length, null) import qualified Data.Char as C import qualified Data.List as L import qualified Data.List.Split as LS +-- | Get the Unicode code point of the character at a specific index, returning Nothing if out of bounds. +charAt :: Int -> String -> Maybe Int +charAt i s + | i < 0 || i >= L.length s = Nothing + | otherwise = Just (C.ord (s !! i)) + -- | Concatenate a list of strings into a single string. -cat :: [String] -> String -cat = L.concat +concat :: [String] -> String +concat = L.concat -- | Concatenate two strings. -cat2 :: String -> String -> String -cat2 s1 s2 = s1 ++ s2 +concat2 :: String -> String -> String +concat2 s1 s2 = s1 ++ s2 -- | Convert a list of Unicode code points to a string. fromList :: [Int] -> String fromList = fmap C.chr -- | Join a list of strings with a separator between each element. -intercalate :: String -> [String] -> String -intercalate = L.intercalate +join :: String -> [String] -> String +join = L.intercalate -- | Return the length of a string. length :: String -> Int length = L.length - --- | Get the Unicode code point of the character at a specific index, returning Nothing if out of bounds. -maybeCharAt :: Int -> String -> Maybe Int -maybeCharAt i s - | i < 0 || i >= L.length s = Nothing - | otherwise = Just (C.ord (s !! i)) -- | Split a string into lines. lines :: String -> [String] diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs @@ -14,6 +14,7 @@ import System.Exit (ExitCode(..), exitWith) import qualified System.Directory as Dir import qualified System.Environment as Env +import qualified System.IO as SIO import qualified System.IO.Error as IOE import qualified System.Process as P @@ -66,7 +67,27 @@ E.catch (Right . File.FilePath <$> Dir.getCurrentDirectory) (\e -> pure $ Left $ SystemError.SystemErrorOther (IOE.ioeGetErrorString (e :: IOError))) +-- | Read the complete contents of standard input as raw bytes. +readStdin :: IO (Either SystemError.SystemError BS.ByteString) +readStdin = withStdioError BS.hGetContents SIO.stdin + +-- | Write raw bytes to standard error. +writeStderr :: BS.ByteString -> IO (Either SystemError.SystemError ()) +writeStderr = withStdioError' BS.hPut SIO.stderr + +-- | Write raw bytes to standard output. +writeStdout :: BS.ByteString -> IO (Either SystemError.SystemError ()) +writeStdout = withStdioError' BS.hPut SIO.stdout + -- Helpers (not primitives) + +withStdioError :: (SIO.Handle -> IO a) -> SIO.Handle -> IO (Either SystemError.SystemError a) +withStdioError action handle = + E.catch (Right <$> action handle) + (\e -> pure $ Left $ SystemError.SystemErrorOther (IOE.ioeGetErrorString (e :: IOError))) + +withStdioError' :: (SIO.Handle -> a -> IO ()) -> SIO.Handle -> a -> IO (Either SystemError.SystemError ()) +withStdioError' action handle x = withStdioError (`action` x) handle -- | Convert the environment map to the association list System.Process expects. toEnvList :: M.Map System.EnvironmentVariable String -> [(String, String)] diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs b/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs --- a/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs +++ b/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs @@ -12,12 +12,15 @@ import qualified Hydra.Overlay.Haskell.Lib.Chars as Chars import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Functions as Functions +import qualified Hydra.Overlay.Haskell.Lib.Hashing as Hashing import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Regex as Regex import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets @@ -28,12 +31,15 @@ import qualified Hydra.Lib.Eithers as DefEithers import qualified Hydra.Lib.Equality as DefEquality import qualified Hydra.Lib.Files as DefFiles +import qualified Hydra.Lib.Functions as DefFunctions +import qualified Hydra.Lib.Hashing as DefHashing import qualified Hydra.Lib.Lists as DefLists import qualified Hydra.Lib.Literals as DefLiterals import qualified Hydra.Lib.Logic as DefLogic import qualified Hydra.Lib.Maps as DefMaps import qualified Hydra.Lib.Math as DefMath import qualified Hydra.Lib.Optionals as DefOptionals +import qualified Hydra.Lib.Ordering as DefOrdering import qualified Hydra.Lib.Pairs as DefPairs import qualified Hydra.Lib.Regex as DefRegex import qualified Hydra.Lib.Sets as DefSets @@ -44,37 +50,6 @@ import qualified Data.List as L --- Type variables (TypeVar) for primitive type schemes --- Unconstrained -_a, _b, _c, _d, _k, _k1, _k2, _s, _v, _v1, _v2, _w, _x, _y, _z :: TypeVar -_a = v "a" -_b = v "b" -_c = v "c" -_d = v "d" -_k = v "k" -_k1 = v "k1" -_k2 = v "k2" -_s = v "s" -_v = v "v" -_v1 = v "v1" -_v2 = v "v2" -_w = v "w" -_x = v "x" -_y = v "y" -_z = v "z" - --- Ord-constrained -_kOrd, _k1Ord, _k2Ord, _xOrd, _yOrd :: TypeVar -_kOrd = vOrd "k" -_k1Ord = vOrd "k1" -_k2Ord = vOrd "k2" -_xOrd = vOrd "x" -_yOrd = vOrd "y" - --- Eq-constrained -_xEq :: TypeVar -_xEq = vEq "x" - -- Term coders for type variables (used in primitive implementations) a_, b_, c_, d_, k_, k1_, k2_, s_, v_, v1_, v2_, w_, x_, y_, z_ :: TermCoder Term a_ = variable "a" @@ -112,22 +87,25 @@ hydraLibChars :: Library hydraLibChars = standardLibrary [ - prim1 DefChars.isAlphaNum Chars.isAlphaNum [] int32 boolean, - prim1 DefChars.isLower Chars.isLower [] int32 boolean, - prim1 DefChars.isSpace Chars.isSpace [] int32 boolean, - prim1 DefChars.isUpper Chars.isUpper [] int32 boolean, - prim1 DefChars.toLower Chars.toLower [] int32 int32, - prim1 DefChars.toUpper Chars.toUpper [] int32 int32] + prim1 DefChars.isAlpha Chars.isAlpha int32 boolean, + prim1 DefChars.isAlphaNum Chars.isAlphaNum int32 boolean, + prim1 DefChars.isDigit Chars.isDigit int32 boolean, + prim1 DefChars.isLower Chars.isLower int32 boolean, + prim1 DefChars.isSpace Chars.isSpace int32 boolean, + prim1 DefChars.isUpper Chars.isUpper int32 boolean, + prim1 DefChars.toLower Chars.toLower int32 int32, + prim1 DefChars.toUpper Chars.toUpper int32 int32] hydraLibEffects :: Library hydraLibEffects = standardLibrary [ unsupportedEffectPrimitive DefEffects.apply, unsupportedEffectPrimitive DefEffects.bind, unsupportedEffectPrimitive DefEffects.compose, - unsupportedEffectPrimitive DefEffects.foldl, + unsupportedEffectPrimitive DefEffects.foldList, unsupportedEffectPrimitive DefEffects.map, unsupportedEffectPrimitive DefEffects.mapList, unsupportedEffectPrimitive DefEffects.mapOptional, + unsupportedEffectPrimitive DefEffects.mapSet, unsupportedEffectPrimitive DefEffects.pure] hydraLibFiles :: Library @@ -146,278 +124,315 @@ hydraLibEithers :: Library hydraLibEithers = standardLibrary [ - prim3 DefEithers.bimap Eithers.bimap [_x, _y, _z, _w] (funT x_ z_) (funT y_ w_) (Prims.either_ x_ y_) (Prims.either_ z_ w_), - prim2 DefEithers.bind Eithers.bind [_x, _y, _z] (Prims.either_ x_ y_) (fun y_ (Prims.either_ x_ z_)) (Prims.either_ x_ z_), - prim3 DefEithers.either Eithers.either [_x, _y, _z] (funT x_ z_) (funT y_ z_) (Prims.either_ x_ y_) z_, - prim3 DefEithers.foldl Eithers.foldl [_x, _y, _z] (fun x_ (fun y_ (Prims.either_ z_ x_))) x_ (list y_) (Prims.either_ z_ x_), - Prims.lazyArgs [0] $ prim2 DefEithers.fromLeft Eithers.fromLeft [_x, _y] x_ (Prims.either_ x_ y_) x_, - Prims.lazyArgs [0] $ prim2 DefEithers.fromRight Eithers.fromRight [_x, _y] y_ (Prims.either_ x_ y_) y_, - prim1 DefEithers.isLeft Eithers.isLeft [_x, _y] (Prims.either_ x_ y_) boolean, - prim1 DefEithers.isRight Eithers.isRight [_x, _y] (Prims.either_ x_ y_) boolean, - prim1 DefEithers.lefts Eithers.lefts [_x, _y] (list $ Prims.either_ x_ y_) (list x_), - prim2 DefEithers.map Eithers.map [_x, _y, _z] (funT x_ y_) (Prims.either_ z_ x_) (Prims.either_ z_ y_), - prim2 DefEithers.mapList Eithers.mapList [_x, _y, _z] (fun x_ (Prims.either_ z_ y_)) (list x_) (Prims.either_ z_ (list y_)), - prim2 DefEithers.mapOptional Eithers.mapOptional [_x, _y, _z] (fun x_ (Prims.either_ z_ y_)) (optional x_) (Prims.either_ z_ (optional y_)), - prim2 DefEithers.mapSet Eithers.mapSet [_x, _y, _z] (fun x_ (Prims.either_ z_ y_)) (set x_) (Prims.either_ z_ (set y_)), - prim1 DefEithers.partitionEithers Eithers.partitionEithers [_x, _y] (list $ Prims.either_ x_ y_) (pair (list x_) (list y_)), - prim1 DefEithers.rights Eithers.rights [_x, _y] (list $ Prims.either_ x_ y_) (list y_)] + prim2 DefEithers.apply Eithers.apply (Prims.either_ x_ (funT y_ z_)) (Prims.either_ x_ y_) (Prims.either_ x_ z_), + prim3 DefEithers.bimap Eithers.bimap (funT x_ z_) (funT y_ w_) (Prims.either_ x_ y_) (Prims.either_ z_ w_), + prim2 DefEithers.bind Eithers.bind (Prims.either_ x_ y_) (fun y_ (Prims.either_ x_ z_)) (Prims.either_ x_ z_), + prim3 DefEithers.compose Eithers.compose (fun x_ (Prims.either_ w_ y_)) (fun y_ (Prims.either_ w_ z_)) x_ (Prims.either_ w_ z_), + prim3 DefEithers.either Eithers.either (funT x_ z_) (funT y_ z_) (Prims.either_ x_ y_) z_, + prim3 DefEithers.foldList Eithers.foldList (fun x_ (fun y_ (Prims.either_ z_ x_))) x_ (list y_) (Prims.either_ z_ x_), + prim3 DefEithers.foldList Eithers.foldList (fun x_ (fun y_ (Prims.either_ z_ x_))) x_ (list y_) (Prims.either_ z_ x_), + prim1 DefEithers.isLeft Eithers.isLeft (Prims.either_ x_ y_) boolean, + prim1 DefEithers.isRight Eithers.isRight (Prims.either_ x_ y_) boolean, + prim1 DefEithers.lefts Eithers.lefts (list $ Prims.either_ x_ y_) (list x_), + prim2 DefEithers.map Eithers.map (funT x_ y_) (Prims.either_ z_ x_) (Prims.either_ z_ y_), + prim2 DefEithers.mapList Eithers.mapList (fun x_ (Prims.either_ z_ y_)) (list x_) (Prims.either_ z_ (list y_)), + prim2 DefEithers.mapOptional Eithers.mapOptional (fun x_ (Prims.either_ z_ y_)) (optional x_) (Prims.either_ z_ (optional y_)), + prim2 DefEithers.mapSet Eithers.mapSet (fun x_ (Prims.either_ z_ y_)) (set x_) (Prims.either_ z_ (set y_)), + prim1 DefEithers.partition Eithers.partition (list $ Prims.either_ x_ y_) (pair (list x_) (list y_)), + prim1 DefEithers.partition Eithers.partition (list $ Prims.either_ x_ y_) (pair (list x_) (list y_)), + prim1 DefEithers.pure Eithers.pure y_ (Prims.either_ x_ y_), + prim1 DefEithers.rights Eithers.rights (list $ Prims.either_ x_ y_) (list y_)] hydraLibEquality :: Library hydraLibEquality = standardLibrary [ - prim2 DefEquality.compare Equality.compare [_xOrd] x_ x_ comparison, - prim2 DefEquality.equal Equality.equal [_xEq] x_ x_ boolean, - prim2 DefEquality.gt Equality.gt [_xOrd] x_ x_ boolean, - prim2 DefEquality.gte Equality.gte [_xOrd] x_ x_ boolean, - prim1 DefEquality.identity Equality.identity [_x] x_ x_, - prim2 DefEquality.lt Equality.lt [_xOrd] x_ x_ boolean, - prim2 DefEquality.lte Equality.lte [_xOrd] x_ x_ boolean, - prim2 DefEquality.max Equality.max [_xOrd] x_ x_ x_, - prim2 DefEquality.min Equality.min [_xOrd] x_ x_ x_] + prim2 DefEquality.equal Equality.equal x_ x_ boolean, + prim2 DefEquality.notEqual Equality.notEqual x_ x_ boolean] +hydraLibOrdering :: Library +hydraLibOrdering = standardLibrary [ + prim2 DefOrdering.compare Ordering.compare x_ x_ comparison, + prim2 DefOrdering.gt Ordering.gt x_ x_ boolean, + prim2 DefOrdering.gte Ordering.gte x_ x_ boolean, + prim2 DefOrdering.lt Ordering.lt x_ x_ boolean, + prim2 DefOrdering.lte Ordering.lte x_ x_ boolean, + prim2 DefOrdering.max Ordering.max x_ x_ x_, + prim2 DefOrdering.min Ordering.min x_ x_ x_] + +hydraLibFunctions :: Library +hydraLibFunctions = standardLibrary [ + prim3 DefFunctions.compose Functions.compose (funT y_ z_) (funT x_ y_) x_ z_, + prim2 DefFunctions.const Functions.const x_ y_ x_, + prim3 DefFunctions.flip Functions.flip (funT x_ (funT y_ z_)) y_ x_ z_, + prim1 DefFunctions.identity Functions.identity x_ x_] + hydraLibLists :: Library hydraLibLists = standardLibrary [ - prim2 DefLists.apply Lists.apply [_x, _y] (list $ funT x_ y_) (list x_) (list y_), - prim2 DefLists.bind Lists.bind [_x, _y] (list x_) (fun x_ (list y_)) (list y_), - prim1 DefLists.concat Lists.concat [_x] (list (list x_)) (list x_), - prim2 DefLists.concat2 Lists.concat2 [_x] (list x_) (list x_) (list x_), - prim2 DefLists.cons Lists.cons [_x] x_ (list x_) (list x_), - prim2 DefLists.drop Lists.drop [_x] int32 (list x_) (list x_), - prim2 DefLists.dropWhile Lists.dropWhile [_x] (fun x_ boolean) (list x_) (list x_), - prim2 DefLists.elem Lists.elem [_xEq] x_ (list x_) boolean, - prim2 DefLists.filter Lists.filter [_x] (fun x_ boolean) (list x_) (list x_), - prim2 DefLists.find Lists.find [_x] (fun x_ boolean) (list x_) (optional x_), - prim3 DefLists.foldl Lists.foldl [_y, _x] (funT y_ (funT x_ y_)) y_ (list x_) y_, - prim3 DefLists.foldr Lists.foldr [_x, _y] (funT x_ (funT y_ y_)) y_ (list x_) y_, - prim1 DefLists.group Lists.group [_xEq] (list x_) (list (list x_)), - prim2 DefLists.intercalate Lists.intercalate [_x] (list x_) (list (list x_)) (list x_), - prim2 DefLists.intersperse Lists.intersperse [_x] x_ (list x_) (list x_), - prim1 DefLists.length Lists.length [_x] (list x_) int32, - prim2 DefLists.map Lists.map [_x, _y] (funT x_ y_) (list x_) (list y_), - prim2 DefLists.maybeAt Lists.maybeAt [_x] int32 (list x_) (optional x_), - prim1 DefLists.maybeHead Lists.maybeHead [_x] (list x_) (optional x_), - prim1 DefLists.maybeInit Lists.maybeInit [_x] (list x_) (optional (list x_)), - prim1 DefLists.maybeLast Lists.maybeLast [_x] (list x_) (optional x_), - prim1 DefLists.maybeTail Lists.maybeTail [_x] (list x_) (optional (list x_)), - prim1 DefLists.nub Lists.nub [_xEq] (list x_) (list x_), - prim1 DefLists.null Lists.null [_x] (list x_) boolean, - prim2 DefLists.partition Lists.partition [_x] (fun x_ boolean) (list x_) (pair (list x_) (list x_)), - prim1 DefLists.pure Lists.pure [_x] x_ (list x_), - prim2 DefLists.replicate Lists.replicate [_x] int32 x_ (list x_), - prim1 DefLists.reverse Lists.reverse [_x] (list x_) (list x_), - prim1 DefLists.singleton Lists.singleton [_x] x_ (list x_), - prim1 DefLists.sort Lists.sort [_xOrd] (list x_) (list x_), - prim2 DefLists.sortOn Lists.sortOn [_x, _yOrd] (fun x_ y_) (list x_) (list x_), - prim2 DefLists.span Lists.span [_x] (fun x_ boolean) (list x_) (pair (list x_) (list x_)), - prim2 DefLists.take Lists.take [_x] int32 (list x_) (list x_), - prim1 DefLists.transpose Lists.transpose [_x] (list (list x_)) (list (list x_)), - prim1 DefLists.uncons Lists.uncons [_x] (list x_) (optional (pair x_ (list x_))), - prim2 DefLists.zip Lists.zip [_x, _y] (list x_) (list y_) (list (pair x_ y_)), - prim3 DefLists.zipWith Lists.zipWith [_x, _y, _z] (funT x_ $ funT y_ z_) (list x_) (list y_) (list z_)] + prim2 DefLists.apply Lists.apply (list $ funT x_ y_) (list x_) (list y_), + prim2 DefLists.at Lists.at int32 (list x_) (optional x_), + prim2 DefLists.bind Lists.bind (list x_) (fun x_ (list y_)) (list y_), + prim3 DefLists.compose Lists.compose (fun x_ (list y_)) (fun y_ (list z_)) x_ (list z_), + prim1 DefLists.concat Lists.concat (list (list x_)) (list x_), + prim2 DefLists.concat2 Lists.concat2 (list x_) (list x_) (list x_), + prim2 DefLists.cons Lists.cons x_ (list x_) (list x_), + prim1 DefLists.distinct Lists.distinct (list x_) (list x_), + prim2 DefLists.drop Lists.drop int32 (list x_) (list x_), + prim2 DefLists.dropWhile Lists.dropWhile (fun x_ boolean) (list x_) (list x_), + prim2 DefLists.member Lists.member x_ (list x_) boolean, + prim2 DefLists.filter Lists.filter (fun x_ boolean) (list x_) (list x_), + prim2 DefLists.find Lists.find (fun x_ boolean) (list x_) (optional x_), + prim3 DefLists.foldList Lists.foldList (fun x_ (fun y_ (list x_))) x_ (list y_) (list x_), + prim3 DefLists.foldl Lists.foldl (funT y_ (funT x_ y_)) y_ (list x_) y_, + prim3 DefLists.foldr Lists.foldr (funT x_ (funT y_ y_)) y_ (list x_) y_, + prim1 DefLists.group Lists.group (list x_) (list (list x_)), + prim1 DefLists.head Lists.head (list x_) (optional x_), + prim1 DefLists.init Lists.init (list x_) (optional (list x_)), + prim2 DefLists.join Lists.join (list x_) (list (list x_)) (list x_), + prim2 DefLists.join Lists.join (list x_) (list (list x_)) (list x_), + prim2 DefLists.intersperse Lists.intersperse x_ (list x_) (list x_), + prim1 DefLists.last Lists.last (list x_) (optional x_), + prim1 DefLists.length Lists.length (list x_) int32, + prim2 DefLists.map Lists.map (funT x_ y_) (list x_) (list y_), + prim2 DefLists.mapList Lists.mapList (fun x_ (list y_)) (list x_) (list (list y_)), + prim2 DefLists.mapOptional Lists.mapOptional (fun x_ (list y_)) (optional x_) (list (optional y_)), + prim2 DefLists.mapSet Lists.mapSet (fun x_ (list y_)) (set x_) (list (set y_)), + prim2 DefLists.member Lists.member x_ (list x_) boolean, + prim2 DefLists.at Lists.at int32 (list x_) (optional x_), + prim1 DefLists.head Lists.head (list x_) (optional x_), + prim1 DefLists.init Lists.init (list x_) (optional (list x_)), + prim1 DefLists.last Lists.last (list x_) (optional x_), + prim1 DefLists.tail Lists.tail (list x_) (optional (list x_)), + prim1 DefLists.distinct Lists.distinct (list x_) (list x_), + prim1 DefLists.null Lists.null (list x_) boolean, + prim2 DefLists.partition Lists.partition (fun x_ boolean) (list x_) (pair (list x_) (list x_)), + prim1 DefLists.pure Lists.pure x_ (list x_), + prim2 DefLists.replicate Lists.replicate int32 x_ (list x_), + prim1 DefLists.reverse Lists.reverse (list x_) (list x_), + prim1 DefLists.singleton Lists.singleton x_ (list x_), + prim1 DefLists.sort Lists.sort (list x_) (list x_), + prim2 DefLists.sortBy Lists.sortBy (fun x_ y_) (list x_) (list x_), + prim2 DefLists.sortBy Lists.sortBy (fun x_ y_) (list x_) (list x_), + prim2 DefLists.span Lists.span (fun x_ boolean) (list x_) (pair (list x_) (list x_)), + prim1 DefLists.tail Lists.tail (list x_) (optional (list x_)), + prim2 DefLists.take Lists.take int32 (list x_) (list x_), + prim2 DefLists.takeWhile Lists.takeWhile (fun x_ boolean) (list x_) (list x_), + prim1 DefLists.transpose Lists.transpose (list (list x_)) (list (list x_)), + prim1 DefLists.uncons Lists.uncons (list x_) (optional (pair x_ (list x_))), + prim2 DefLists.zip Lists.zip (list x_) (list y_) (list (pair x_ y_)), + prim3 DefLists.zipWith Lists.zipWith (funT x_ $ funT y_ z_) (list x_) (list y_) (list z_)] hydraLibLiterals :: Library hydraLibLiterals = standardLibrary [ - prim1 DefLiterals.bigintToDecimal Literals.bigintToDecimal [] bigint decimal, - prim1 DefLiterals.bigintToInt8 Literals.bigintToInt8 [] bigint int8, - prim1 DefLiterals.bigintToInt16 Literals.bigintToInt16 [] bigint int16, - prim1 DefLiterals.bigintToInt32 Literals.bigintToInt32 [] bigint int32, - prim1 DefLiterals.bigintToInt64 Literals.bigintToInt64 [] bigint int64, - prim1 DefLiterals.bigintToUint8 Literals.bigintToUint8 [] bigint uint8, - prim1 DefLiterals.bigintToUint16 Literals.bigintToUint16 [] bigint uint16, - prim1 DefLiterals.bigintToUint32 Literals.bigintToUint32 [] bigint uint32, - prim1 DefLiterals.bigintToUint64 Literals.bigintToUint64 [] bigint uint64, - prim1 DefLiterals.binaryToBytes Literals.binaryToBytes [] binary (list int32), - prim1 DefLiterals.binaryToString Literals.binaryToString [] binary string, - prim1 DefLiterals.decimalToBigint Literals.decimalToBigint [] decimal bigint, - prim1 DefLiterals.decimalToFloat32 Literals.decimalToFloat32 [] decimal float32, - prim1 DefLiterals.decimalToFloat64 Literals.decimalToFloat64 [] decimal float64, - prim1 DefLiterals.float32ToDecimal Literals.float32ToDecimal [] float32 decimal, - prim1 DefLiterals.float32ToFloat64 Literals.float32ToFloat64 [] float32 float64, - prim1 DefLiterals.float64ToDecimal Literals.float64ToDecimal [] float64 decimal, - prim1 DefLiterals.float64ToFloat32 Literals.float64ToFloat32 [] float64 float32, - prim1 DefLiterals.int8ToBigint Literals.int8ToBigint [] int8 bigint, - prim1 DefLiterals.int16ToBigint Literals.int16ToBigint [] int16 bigint, - prim1 DefLiterals.int32ToBigint Literals.int32ToBigint [] int32 bigint, - prim1 DefLiterals.int64ToBigint Literals.int64ToBigint [] int64 bigint, - prim1 DefLiterals.readBigint Literals.readBigint [] string (optional bigint), - prim1 DefLiterals.readBoolean Literals.readBoolean [] string (optional boolean), - prim1 DefLiterals.readDecimal Literals.readDecimal [] string (optional decimal), - prim1 DefLiterals.readFloat32 Literals.readFloat32 [] string (optional float32), - prim1 DefLiterals.readFloat64 Literals.readFloat64 [] string (optional float64), - prim1 DefLiterals.readInt8 Literals.readInt8 [] string (optional int8), - prim1 DefLiterals.readInt16 Literals.readInt16 [] string (optional int16), - prim1 DefLiterals.readInt32 Literals.readInt32 [] string (optional int32), - prim1 DefLiterals.readInt64 Literals.readInt64 [] string (optional int64), - prim1 DefLiterals.readString Literals.readString [] string (optional string), - prim1 DefLiterals.readUint8 Literals.readUint8 [] string (optional uint8), - prim1 DefLiterals.readUint16 Literals.readUint16 [] string (optional uint16), - prim1 DefLiterals.readUint32 Literals.readUint32 [] string (optional uint32), - prim1 DefLiterals.readUint64 Literals.readUint64 [] string (optional uint64), - prim1 DefLiterals.showBigint Literals.showBigint [] bigint string, - prim1 DefLiterals.showBoolean Literals.showBoolean [] boolean string, - prim1 DefLiterals.showDecimal Literals.showDecimal [] decimal string, - prim1 DefLiterals.showFloat32 Literals.showFloat32 [] float32 string, - prim1 DefLiterals.showFloat64 Literals.showFloat64 [] float64 string, - prim1 DefLiterals.showInt8 Literals.showInt8 [] int8 string, - prim1 DefLiterals.showInt16 Literals.showInt16 [] int16 string, - prim1 DefLiterals.showInt32 Literals.showInt32 [] int32 string, - prim1 DefLiterals.showInt64 Literals.showInt64 [] int64 string, - prim1 DefLiterals.showString Literals.showString [] string string, - prim1 DefLiterals.showUint8 Literals.showUint8 [] uint8 string, - prim1 DefLiterals.showUint16 Literals.showUint16 [] uint16 string, - prim1 DefLiterals.showUint32 Literals.showUint32 [] uint32 string, - prim1 DefLiterals.showUint64 Literals.showUint64 [] uint64 string, - prim1 DefLiterals.stringToBinary Literals.stringToBinary [] string binary, - prim1 DefLiterals.uint8ToBigint Literals.uint8ToBigint [] uint8 bigint, - prim1 DefLiterals.uint16ToBigint Literals.uint16ToBigint [] uint16 bigint, - prim1 DefLiterals.uint32ToBigint Literals.uint32ToBigint [] uint32 bigint, - prim1 DefLiterals.uint64ToBigint Literals.uint64ToBigint [] uint64 bigint] + prim1 DefLiterals.bigintToDecimal Literals.bigintToDecimal bigint decimal, + prim1 DefLiterals.bigintToInt8 Literals.bigintToInt8 bigint int8, + prim1 DefLiterals.bigintToInt16 Literals.bigintToInt16 bigint int16, + prim1 DefLiterals.bigintToInt32 Literals.bigintToInt32 bigint int32, + prim1 DefLiterals.bigintToInt64 Literals.bigintToInt64 bigint int64, + prim1 DefLiterals.bigintToUint8 Literals.bigintToUint8 bigint uint8, + prim1 DefLiterals.bigintToUint16 Literals.bigintToUint16 bigint uint16, + prim1 DefLiterals.bigintToUint32 Literals.bigintToUint32 bigint uint32, + prim1 DefLiterals.bigintToUint64 Literals.bigintToUint64 bigint uint64, + prim1 DefLiterals.binaryToBytes Literals.binaryToBytes binary (list int32), + prim1 DefLiterals.binaryToBase64 Literals.binaryToBase64 binary string, + prim1 DefLiterals.decimalToBigint Literals.decimalToBigint decimal bigint, + prim1 DefLiterals.decimalToFloat32 Literals.decimalToFloat32 decimal float32, + prim1 DefLiterals.decimalToFloat64 Literals.decimalToFloat64 decimal float64, + prim1 DefLiterals.float32ToDecimal Literals.float32ToDecimal float32 decimal, + prim1 DefLiterals.float32ToFloat64 Literals.float32ToFloat64 float32 float64, + prim1 DefLiterals.float64ToDecimal Literals.float64ToDecimal float64 decimal, + prim1 DefLiterals.float64ToFloat32 Literals.float64ToFloat32 float64 float32, + prim1 DefLiterals.int8ToBigint Literals.int8ToBigint int8 bigint, + prim1 DefLiterals.int16ToBigint Literals.int16ToBigint int16 bigint, + prim1 DefLiterals.int32ToBigint Literals.int32ToBigint int32 bigint, + prim1 DefLiterals.int64ToBigint Literals.int64ToBigint int64 bigint, + prim1 DefLiterals.readBigint Literals.readBigint string (optional bigint), + prim1 DefLiterals.parseBoolean Literals.parseBoolean string (optional boolean), + prim1 DefLiterals.readDecimal Literals.readDecimal string (optional decimal), + prim1 DefLiterals.readFloat32 Literals.readFloat32 string (optional float32), + prim1 DefLiterals.readFloat64 Literals.readFloat64 string (optional float64), + prim1 DefLiterals.readInt8 Literals.readInt8 string (optional int8), + prim1 DefLiterals.readInt16 Literals.readInt16 string (optional int16), + prim1 DefLiterals.readInt32 Literals.readInt32 string (optional int32), + prim1 DefLiterals.readInt64 Literals.readInt64 string (optional int64), + prim1 DefLiterals.parseString Literals.parseString string (optional string), + prim1 DefLiterals.readUint8 Literals.readUint8 string (optional uint8), + prim1 DefLiterals.readUint16 Literals.readUint16 string (optional uint16), + prim1 DefLiterals.readUint32 Literals.readUint32 string (optional uint32), + prim1 DefLiterals.readUint64 Literals.readUint64 string (optional uint64), + prim1 DefLiterals.showBigint Literals.showBigint bigint string, + prim1 DefLiterals.printBoolean Literals.printBoolean boolean string, + prim1 DefLiterals.showDecimal Literals.showDecimal decimal string, + prim1 DefLiterals.showFloat32 Literals.showFloat32 float32 string, + prim1 DefLiterals.showFloat64 Literals.showFloat64 float64 string, + prim1 DefLiterals.showInt8 Literals.showInt8 int8 string, + prim1 DefLiterals.showInt16 Literals.showInt16 int16 string, + prim1 DefLiterals.showInt32 Literals.showInt32 int32 string, + prim1 DefLiterals.showInt64 Literals.showInt64 int64 string, + prim1 DefLiterals.printString Literals.printString string string, + prim1 DefLiterals.showUint8 Literals.showUint8 uint8 string, + prim1 DefLiterals.showUint16 Literals.showUint16 uint16 string, + prim1 DefLiterals.showUint32 Literals.showUint32 uint32 string, + prim1 DefLiterals.showUint64 Literals.showUint64 uint64 string, + prim1 DefLiterals.base64ToBinary Literals.base64ToBinary string binary, + prim1 DefLiterals.uint8ToBigint Literals.uint8ToBigint uint8 bigint, + prim1 DefLiterals.uint16ToBigint Literals.uint16ToBigint uint16 bigint, + prim1 DefLiterals.uint32ToBigint Literals.uint32ToBigint uint32 bigint, + prim1 DefLiterals.uint64ToBigint Literals.uint64ToBigint uint64 bigint] hydraLibLogic :: Library hydraLibLogic = standardLibrary [ - prim2 DefLogic.and Logic.and [] boolean boolean boolean, - Prims.lazyArgs [1, 2] $ prim3 DefLogic.ifElse Logic.ifElse [_x] boolean x_ x_ x_, - prim1 DefLogic.not Logic.not [] boolean boolean, - prim2 DefLogic.or Logic.or [] boolean boolean boolean] + prim2 DefLogic.and Logic.and boolean boolean boolean, + prim3 DefLogic.ifElse Logic.ifElse boolean x_ x_ x_, + prim1 DefLogic.not Logic.not boolean boolean, + prim2 DefLogic.or Logic.or boolean boolean boolean] hydraLibMaps :: Library hydraLibMaps = standardLibrary [ - prim3 DefMaps.alter Maps.alter [_v, _kOrd] (fun (optional v_) (optional v_)) k_ mapKv mapKv, - prim3 DefMaps.bimap Maps.bimap [_k1Ord, _k2Ord, _v1, _v2] (fun k1_ k2_) (fun v1_ v2_) (Prims.map k1_ v1_) (Prims.map k2_ v2_), - prim2 DefMaps.delete Maps.delete [_kOrd, _v] k_ mapKv mapKv, - prim1 DefMaps.elems Maps.elems [_kOrd, _v] mapKv (list v_), - prim0 DefMaps.empty Maps.empty [_kOrd, _v] mapKv, - prim2 DefMaps.filter Maps.filter [_v, _kOrd] (fun v_ boolean) mapKv mapKv, - prim2 DefMaps.filterWithKey Maps.filterWithKey [_kOrd, _v] (fun k_ (fun v_ boolean)) mapKv mapKv, - Prims.lazyArgs [0] $ prim3 DefMaps.findWithDefault Maps.findWithDefault [_v, _kOrd] v_ k_ mapKv v_, - prim1 DefMaps.fromList Maps.fromList [_kOrd, _v] (list $ pair k_ v_) mapKv, - prim3 DefMaps.insert Maps.insert [_kOrd, _v] k_ v_ mapKv mapKv, - prim1 DefMaps.keys Maps.keys [_kOrd, _v] mapKv (list k_), - prim2 DefMaps.lookup Maps.lookup [_kOrd, _v] k_ mapKv (optional v_), - prim2 DefMaps.map Maps.map [_v1, _v2, _kOrd] (funT v1_ v2_) (Prims.map k_ v1_) (Prims.map k_ v2_), - prim2 DefMaps.mapKeys Maps.mapKeys [_k1Ord, _k2Ord, _v] (fun k1_ k2_) (Prims.map k1_ v_) (Prims.map k2_ v_), - prim2 DefMaps.member Maps.member [_kOrd, _v] k_ mapKv boolean, - prim1 DefMaps.null Maps.null [_kOrd, _v] mapKv boolean, - prim2 DefMaps.singleton Maps.singleton [_kOrd, _v] k_ v_ mapKv, - prim1 DefMaps.size Maps.size [_kOrd, _v] mapKv int32, - prim1 DefMaps.toList Maps.toList [_kOrd, _v] mapKv (list $ pair k_ v_), - prim2 DefMaps.union Maps.union [_kOrd, _v] mapKv mapKv mapKv] + prim3 DefMaps.alter Maps.alter (fun (optional v_) (optional v_)) k_ mapKv mapKv, + prim3 DefMaps.bimap Maps.bimap (fun k1_ k2_) (fun v1_ v2_) (Prims.map k1_ v1_) (Prims.map k2_ v2_), + prim2 DefMaps.delete Maps.delete k_ mapKv mapKv, + prim2 DefMaps.difference Maps.difference mapKv mapKv mapKv, + prim1 DefMaps.elems Maps.elems mapKv (list v_), + prim0 DefMaps.empty Maps.empty mapKv, + prim2 DefMaps.filter Maps.filter (fun v_ boolean) mapKv mapKv, + prim2 DefMaps.filterWithKey Maps.filterWithKey (fun k_ (fun v_ boolean)) mapKv mapKv, + prim3 DefMaps.findWithDefault Maps.findWithDefault v_ k_ mapKv v_, + prim1 DefMaps.fromList Maps.fromList (list $ pair k_ v_) mapKv, + prim3 DefMaps.insert Maps.insert k_ v_ mapKv mapKv, + prim2 DefMaps.intersection Maps.intersection mapKv mapKv mapKv, + prim1 DefMaps.keys Maps.keys mapKv (list k_), + prim2 DefMaps.lookup Maps.lookup k_ mapKv (optional v_), + prim2 DefMaps.map Maps.map (funT v1_ v2_) (Prims.map k_ v1_) (Prims.map k_ v2_), + prim2 DefMaps.mapKeys Maps.mapKeys (fun k1_ k2_) (Prims.map k1_ v_) (Prims.map k2_ v_), + prim2 DefMaps.member Maps.member k_ mapKv boolean, + prim1 DefMaps.null Maps.null mapKv boolean, + prim2 DefMaps.singleton Maps.singleton k_ v_ mapKv, + prim1 DefMaps.size Maps.size mapKv int32, + prim1 DefMaps.toList Maps.toList mapKv (list $ pair k_ v_), + prim2 DefMaps.union Maps.union mapKv mapKv mapKv, + prim1 DefMaps.unions Maps.unions (list mapKv) mapKv] where mapKv = Prims.map k_ v_ hydraLibMathFloat64 :: Library hydraLibMathFloat64 = standardLibrary [ - prim1 DefMath.acos Math.acos [] float64 float64, - prim1 DefMath.acosh Math.acosh [] float64 float64, - prim2 DefMath.addFloat64 Math.addFloat64 [] float64 float64 float64, - prim1 DefMath.asin Math.asin [] float64 float64, - prim1 DefMath.asinh Math.asinh [] float64 float64, - prim1 DefMath.atan Math.atan [] float64 float64, - prim2 DefMath.atan2 Math.atan2 [] float64 float64 float64, - prim1 DefMath.atanh Math.atanh [] float64 float64, - prim1 DefMath.ceiling Math.ceiling [] float64 float64, - prim1 DefMath.cos Math.cos [] float64 float64, - prim1 DefMath.cosh Math.cosh [] float64 float64, - prim0 DefMath.e Math.e [] float64, - prim1 DefMath.exp Math.exp [] float64 float64, - prim1 DefMath.floor Math.floor [] float64 float64, - prim1 DefMath.log Math.log [] float64 float64, - prim2 DefMath.logBase Math.logBase [] float64 float64 float64, - prim2 DefMath.mulFloat64 Math.mulFloat64 [] float64 float64 float64, - prim1 DefMath.negateFloat64 Math.negateFloat64 [] float64 float64, - prim0 DefMath.pi Math.pi [] float64, - prim2 DefMath.pow Math.pow [] float64 float64 float64, - prim1 DefMath.round Math.round [] float64 float64, - prim2 DefMath.roundFloat32 Math.roundFloat32 [] int32 float32 float32, - prim2 DefMath.roundFloat64 Math.roundFloat64 [] int32 float64 float64, - prim1 DefMath.sin Math.sin [] float64 float64, - prim1 DefMath.sinh Math.sinh [] float64 float64, - prim1 DefMath.sqrt Math.sqrt [] float64 float64, - prim2 DefMath.subFloat64 Math.subFloat64 [] float64 float64 float64, - prim1 DefMath.tan Math.tan [] float64 float64, - prim1 DefMath.tanh Math.tanh [] float64 float64, - prim1 DefMath.truncate Math.truncate [] float64 float64] + prim1 DefMath.acos Math.acos float64 float64, + prim1 DefMath.acosh Math.acosh float64 float64, + prim2 DefMath.addFloat64 Math.addFloat64 float64 float64 float64, + prim1 DefMath.asin Math.asin float64 float64, + prim1 DefMath.asinh Math.asinh float64 float64, + prim1 DefMath.atan Math.atan float64 float64, + prim2 DefMath.atan2 Math.atan2 float64 float64 float64, + prim1 DefMath.atanh Math.atanh float64 float64, + prim1 DefMath.ceiling Math.ceiling float64 float64, + prim1 DefMath.cos Math.cos float64 float64, + prim1 DefMath.cosh Math.cosh float64 float64, + prim0 DefMath.e Math.e float64, + prim1 DefMath.exp Math.exp float64 float64, + prim1 DefMath.floor Math.floor float64 float64, + prim1 DefMath.log Math.log float64 float64, + prim2 DefMath.logBase Math.logBase float64 float64 float64, + prim2 DefMath.mulFloat64 Math.mulFloat64 float64 float64 float64, + prim1 DefMath.negateFloat64 Math.negateFloat64 float64 float64, + prim0 DefMath.pi Math.pi float64, + prim2 DefMath.pow Math.pow float64 float64 float64, + prim1 DefMath.round Math.round float64 float64, + prim2 DefMath.roundFloat32 Math.roundFloat32 int32 float32 float32, + prim2 DefMath.roundFloat64 Math.roundFloat64 int32 float64 float64, + prim1 DefMath.sin Math.sin float64 float64, + prim1 DefMath.sinh Math.sinh float64 float64, + prim1 DefMath.sqrt Math.sqrt float64 float64, + prim2 DefMath.subFloat64 Math.subFloat64 float64 float64 float64, + prim1 DefMath.tan Math.tan float64 float64, + prim1 DefMath.tanh Math.tanh float64 float64, + prim1 DefMath.truncate Math.truncate float64 float64] hydraLibMathInt32 :: Library hydraLibMathInt32 = standardLibrary [ - prim1 DefMath.abs Math.abs [] int32 int32, - prim2 DefMath.add Math.add [] int32 int32 int32, - prim1 DefMath.even Math.even [] int32 boolean, - prim2 DefMath.max Math.max [] int32 int32 int32, - prim2 DefMath.maybeDiv Math.maybeDiv [] int32 int32 (optional int32), - prim2 DefMath.min Math.min [] int32 int32 int32, - prim2 DefMath.maybeMod Math.maybeMod [] int32 int32 (optional int32), - prim2 DefMath.mul Math.mul [] int32 int32 int32, - prim1 DefMath.negate Math.negate [] int32 int32, - prim1 DefMath.odd Math.odd [] int32 boolean, - prim1 DefMath.maybePred Math.maybePred [] int32 (optional int32), - prim2 DefMath.range Math.range [] int32 int32 (list int32), - prim2 DefMath.maybeRem Math.maybeRem [] int32 int32 (optional int32), - prim1 DefMath.signum Math.signum [] int32 int32, - prim2 DefMath.sub Math.sub [] int32 int32 int32, - prim1 DefMath.maybeSucc Math.maybeSucc [] int32 (optional int32)] + prim1 DefMath.abs Math.abs int32 int32, + prim2 DefMath.add Math.addTerm x_ x_ x_, + prim1 DefMath.even Math.even int32 boolean, + prim2 DefMath.div Math.div int32 int32 (optional int32), + prim2 DefMath.mod Math.mod int32 int32 (optional int32), + prim2 DefMath.mul Math.mulTerm x_ x_ x_, + prim1 DefMath.negate Math.negateTerm x_ x_, + prim1 DefMath.odd Math.odd int32 boolean, + prim2 DefMath.range Math.range int32 int32 (list int32), + prim2 DefMath.rem Math.rem int32 int32 (optional int32), + prim1 DefMath.signum Math.signum int32 int32, + prim2 DefMath.sub Math.subTerm x_ x_ x_] hydraLibOptionals :: Library hydraLibOptionals = standardLibrary [ - prim2 DefOptionals.apply Optionals.apply [_x, _y] (optional $ funT x_ y_) (optional x_) (optional y_), - prim2 DefOptionals.bind Optionals.bind [_x, _y] (optional x_) (fun x_ (optional y_)) (optional y_), - Prims.lazyArgs [1] $ prim3 DefOptionals.cases Optionals.cases [_x, _y] (optional x_) y_ (funT x_ y_) y_, - prim1 DefOptionals.cat Optionals.cat [_x] (list $ optional x_) (list x_), - prim3 DefOptionals.compose Optionals.compose [_x, _y, _z] (fun x_ $ optional y_) (fun y_ $ optional z_) x_ (optional z_), - Prims.lazyArgs [0] $ prim2 DefOptionals.fromOptional Optionals.fromOptional [_x] x_ (optional x_) x_, - prim1 DefOptionals.isGiven Optionals.isGiven [_x] (optional x_) boolean, - prim1 DefOptionals.isNone Optionals.isNone [_x] (optional x_) boolean, - prim2 DefOptionals.map Optionals.map [_x, _y] (funT x_ y_) (optional x_) (optional y_), - prim2 DefOptionals.mapOptional Optionals.mapOptional [_x, _y] (fun x_ $ optional y_) (list x_) (list y_), - prim1 DefOptionals.pure Optionals.pure [_x] x_ (optional x_), - prim1 DefOptionals.toList Optionals.toList [_x] (optional x_) (list x_)] + prim2 DefOptionals.apply Optionals.apply (optional $ funT x_ y_) (optional x_) (optional y_), + prim2 DefOptionals.bind Optionals.bind (optional x_) (fun x_ (optional y_)) (optional y_), + prim3 DefOptionals.cases Optionals.cases (optional x_) y_ (funT x_ y_) y_, + prim1 DefOptionals.givens Optionals.givens (list $ optional x_) (list x_), + prim3 DefOptionals.compose Optionals.compose (fun x_ $ optional y_) (fun y_ $ optional z_) x_ (optional z_), + prim3 DefOptionals.foldList Optionals.foldList (fun x_ (fun y_ (optional x_))) x_ (list y_) (optional x_), + prim2 DefOptionals.withDefault Optionals.withDefault x_ (optional x_) x_, + prim1 DefOptionals.givens Optionals.givens (list $ optional x_) (list x_), + prim1 DefOptionals.isGiven Optionals.isGiven (optional x_) boolean, + prim1 DefOptionals.isNone Optionals.isNone (optional x_) boolean, + prim2 DefOptionals.map Optionals.map (funT x_ y_) (optional x_) (optional y_), + prim2 DefOptionals.mapList Optionals.mapList (fun x_ (optional y_)) (list x_) (optional (list y_)), + prim2 DefOptionals.mapOptional Optionals.mapOptional (fun x_ $ optional y_) (list x_) (list y_), + prim2 DefOptionals.mapSet Optionals.mapSet (fun x_ (optional y_)) (set x_) (optional (set y_)), + prim1 DefOptionals.pure Optionals.pure x_ (optional x_), + prim1 DefOptionals.toList Optionals.toList (optional x_) (list x_), + prim2 DefOptionals.withDefault Optionals.withDefault x_ (optional x_) x_] hydraLibPairs :: Library hydraLibPairs = standardLibrary [ - prim3 DefPairs.bimap Pairs.bimap [_a, _b, _c, _d] (funT a_ c_) (funT b_ d_) (pair a_ b_) (pair c_ d_), - prim1 DefPairs.first Pairs.first [_a, _b] (pair a_ b_) a_, - prim1 DefPairs.second Pairs.second [_a, _b] (pair a_ b_) b_] + prim3 DefPairs.bimap Pairs.bimap (funT a_ c_) (funT b_ d_) (pair a_ b_) (pair c_ d_), + prim1 DefPairs.first Pairs.first (pair a_ b_) a_, + prim1 DefPairs.second Pairs.second (pair a_ b_) b_] hydraLibRegex :: Library hydraLibRegex = standardLibrary [ - prim2 DefRegex.find Regex.find [] string string (optional string), - prim2 DefRegex.findAll Regex.findAll [] string string (list string), - prim2 DefRegex.matches Regex.matches [] string string boolean, - prim3 DefRegex.replace Regex.replace [] string string string string, - prim3 DefRegex.replaceAll Regex.replaceAll [] string string string string, - prim2 DefRegex.split Regex.split [] string string (list string)] + prim2 DefRegex.find Regex.find string string (optional string), + prim2 DefRegex.findAll Regex.findAll string string (list string), + prim2 DefRegex.matches Regex.matches string string boolean, + prim3 DefRegex.replace Regex.replace string string string string, + prim3 DefRegex.replaceAll Regex.replaceAll string string string string, + prim2 DefRegex.split Regex.split string string (list string)] hydraLibSets :: Library hydraLibSets = standardLibrary [ - prim2 DefSets.delete Sets.delete [_xOrd] x_ (set x_) (set x_), - prim2 DefSets.difference Sets.difference [_xOrd] (set x_) (set x_) (set x_), - prim0 DefSets.empty Sets.empty [_xOrd] (set x_), - prim1 DefSets.fromList Sets.fromList [_xOrd] (list x_) (set x_), - prim2 DefSets.insert Sets.insert [_xOrd] x_ (set x_) (set x_), - prim2 DefSets.intersection Sets.intersection [_xOrd] (set x_) (set x_) (set x_), - prim2 DefSets.map Sets.map [_xOrd, _yOrd] (fun x_ y_) (set x_) (set y_), - prim2 DefSets.member Sets.member [_xOrd] x_ (set x_) boolean, - prim1 DefSets.null Sets.null [_xOrd] (set x_) boolean, - prim1 DefSets.singleton Sets.singleton [_xOrd] x_ (set x_), - prim1 DefSets.size Sets.size [_xOrd] (set x_) int32, - prim1 DefSets.toList Sets.toList [_xOrd] (set x_) (list x_), - prim2 DefSets.union Sets.union [_xOrd] (set x_) (set x_) (set x_), - prim1 DefSets.unions Sets.unions [_xOrd] (list $ set x_) (set x_)] + prim2 DefSets.delete Sets.delete x_ (set x_) (set x_), + prim2 DefSets.difference Sets.difference (set x_) (set x_) (set x_), + prim0 DefSets.empty Sets.empty (set x_), + prim2 DefSets.filter Sets.filter (fun x_ boolean) (set x_) (set x_), + prim1 DefSets.fromList Sets.fromList (list x_) (set x_), + prim2 DefSets.insert Sets.insert x_ (set x_) (set x_), + prim2 DefSets.intersection Sets.intersection (set x_) (set x_) (set x_), + prim2 DefSets.map Sets.map (fun x_ y_) (set x_) (set y_), + prim2 DefSets.member Sets.member x_ (set x_) boolean, + prim1 DefSets.null Sets.null (set x_) boolean, + prim1 DefSets.singleton Sets.singleton x_ (set x_), + prim1 DefSets.size Sets.size (set x_) int32, + prim1 DefSets.toList Sets.toList (set x_) (list x_), + prim2 DefSets.union Sets.union (set x_) (set x_) (set x_), + prim1 DefSets.unions Sets.unions (list $ set x_) (set x_)] hydraLibStrings :: Library hydraLibStrings = standardLibrary [ - prim1 DefStrings.cat Strings.cat [] (list string) string, - prim2 DefStrings.cat2 Strings.cat2 [] string string string, - prim1 DefStrings.fromList Strings.fromList [] (list int32) string, - prim2 DefStrings.intercalate Strings.intercalate [] string (list string) string, - prim1 DefStrings.length Strings.length [] string int32, - prim1 DefStrings.lines Strings.lines [] string (list string), - prim2 DefStrings.maybeCharAt Strings.maybeCharAt [] int32 string (optional int32), - prim1 DefStrings.null Strings.null [] string boolean, - prim2 DefStrings.splitOn Strings.splitOn [] string string (list string), - prim1 DefStrings.toList Strings.toList [] string (list int32), - prim1 DefStrings.toLower Strings.toLower [] string string, - prim1 DefStrings.toUpper Strings.toUpper [] string string, - prim1 DefStrings.unlines Strings.unlines [] (list string) string] + prim1 DefStrings.concat Strings.concat (list string) string, + prim2 DefStrings.concat2 Strings.concat2 string string string, + prim2 DefStrings.charAt Strings.charAt int32 string (optional int32), + prim1 DefStrings.concat Strings.concat (list string) string, + prim2 DefStrings.concat2 Strings.concat2 string string string, + prim1 DefStrings.fromList Strings.fromList (list int32) string, + prim2 DefStrings.join Strings.join string (list string) string, + prim2 DefStrings.join Strings.join string (list string) string, + prim1 DefStrings.length Strings.length string int32, + prim1 DefStrings.lines Strings.lines string (list string), + prim2 DefStrings.charAt Strings.charAt int32 string (optional int32), + prim1 DefStrings.null Strings.null string boolean, + prim2 DefStrings.splitOn Strings.splitOn string string (list string), + prim1 DefStrings.toList Strings.toList string (list int32), + prim1 DefStrings.toLower Strings.toLower string string, + prim1 DefStrings.toUpper Strings.toUpper string string, + prim1 DefStrings.unlines Strings.unlines (list string) string] hydraLibSystem :: Library hydraLibSystem = standardLibrary [ @@ -426,12 +441,20 @@ unsupportedEffectPrimitive DefSystem.getEnvironment, unsupportedEffectPrimitive DefSystem.getEnvironmentVariable, unsupportedEffectPrimitive DefSystem.getTime, - unsupportedEffectPrimitive DefSystem.getWorkingDirectory] + unsupportedEffectPrimitive DefSystem.getWorkingDirectory, + unsupportedEffectPrimitive DefSystem.readStdin, + unsupportedEffectPrimitive DefSystem.writeStderr, + unsupportedEffectPrimitive DefSystem.writeStdout] +hydraLibHashing :: Library +hydraLibHashing = standardLibrary [ + prim1 DefHashing.sha256 Hashing.sha256 binary binary, + prim1 DefHashing.sha256Hex Hashing.sha256Hex binary string] + hydraLibText :: Library hydraLibText = standardLibrary [ - prim1 DefText.decodeUtf8 Text.decodeUtf8 [] binary (Prims.either_ string string), - prim1 DefText.encodeUtf8 Text.encodeUtf8 [] string binary] + prim1 DefText.decodeUtf8 Text.decodeUtf8 binary (Prims.either_ string string), + prim1 DefText.encodeUtf8 Text.encodeUtf8 string binary] standardLibraries :: [Library] standardLibraries = [ @@ -440,6 +463,8 @@ hydraLibEithers, hydraLibEquality, hydraLibFiles, + hydraLibFunctions, + hydraLibHashing, hydraLibLists, hydraLibLiterals, hydraLibLogic, @@ -447,6 +472,7 @@ hydraLibMathFloat64, hydraLibMathInt32, hydraLibOptionals, + hydraLibOrdering, hydraLibPairs, hydraLibRegex, hydraLibSets, diff --git a/src/main/haskell/Hydra/Parse/Docs.hs b/src/main/haskell/Hydra/Parse/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Parse/Docs.hs @@ -0,0 +1,70 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Parser for Hydra documentation strings, producing DocSegment lists + +module Hydra.Parse.Docs where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Parse the content between the doc-escape delimiters into an EntityReference. The input is the inner content (tag and optional rhs), e.g. "type hydra.core.Lambda". Returns nothing for unrecognized tags. +parseDocAnnotation :: String -> Maybe Packaging.EntityReference +parseDocAnnotation inner = + + let parts = Strings.splitOn " " inner + tag = Optionals.withDefault "" (Lists.head parts) + rhs = Strings.join " " (Lists.drop 1 parts) + in (Logic.ifElse (Equality.equal tag "primitive") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferencePrimitive (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "term") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferenceTerm (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "type") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferenceType (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "module") (Just (Packaging.EntityReferenceModule (Packaging.ModuleName rhs))) (Logic.ifElse (Equality.equal tag "package") (Just (Packaging.EntityReferencePackage (Packaging.PackageName rhs))) (Logic.ifElse (Equality.equal tag "term-expr") (Just (Packaging.EntityReferenceTermExpr rhs)) (Logic.ifElse (Equality.equal tag "type-expr") (Just (Packaging.EntityReferenceTypeExpr rhs)) Nothing))))))) + +-- | Parse a documentation string into a list of 'DocSegment's. Recognized doc-escape tags become DocSegment.ref segments (wrapping a 'EntityReference'); all other text (including unrecognized doc-escape blocks) becomes DocSegment.text segments. Adjacent text fragments are not merged. +parseDocString :: String -> [Docs.DocSegment] +parseDocString s = + + let parts = Strings.splitOn "{@" s + head_ = Optionals.withDefault "" (Lists.head parts) + tail_ = Lists.drop 1 parts + toSeg = + \part -> + let subparts = Strings.splitOn "}" part + inner = Optionals.withDefault "" (Lists.head subparts) + after = Strings.join "}" (Lists.drop 1 subparts) + mref = parseDocAnnotation inner + in (Optionals.cases mref [ + Docs.DocSegmentText (Strings.concat2 "{@" part)] (\ref -> Optionals.givens [ + Just (Docs.DocSegmentRef ref), + (Logic.ifElse (Equality.equal after "") Nothing (Just (Docs.DocSegmentText after)))])) + in (Lists.cons (Docs.DocSegmentText head_) (Lists.concat (Lists.map toSeg tail_))) diff --git a/src/main/haskell/Hydra/Parse/Regex.hs b/src/main/haskell/Hydra/Parse/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Parse/Regex.hs @@ -0,0 +1,146 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Parser for Hydra's translingual regular-expression syntax (docs/specification/regex.md): text -> hydra.regex AST. Built on the hydra.parsers combinators. Rejects ill-formed patterns (empty alternation branches, empty classes, out-of-range code points) via the ParseResult failure channel, so 'well-formed' is portable across hosts. See issue #567. + +module Hydra.Parse.Regex where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Math as Math +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsers as Parsers +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Parse an alternation of sequences separated by |. When there is more than one branch, each branch must be non-empty; empty branches (a|, |b, a||b, and the nested (a|)) are rejected at every level. A single empty branch is the legal empty case (empty whole pattern / empty group). +alternation :: Parsing.Parser [[Regex.Quantified]] +alternation = + Parsers.bind (Parsers.sepBy1 regexSequence (Parsers.char 124)) (\branches -> + let hasEmpty = Lists.foldl (\acc -> \b -> Logic.or acc (Lists.null b)) False branches + multi = Ordering.gt (Lists.length branches) 1 + in (Logic.ifElse (Logic.and hasEmpty multi) (Parsers.fail "empty alternation branch") (Parsers.pure branches))) + +-- | Parse a single atom: a group ( ... ), a class [ ... ], ., an anchor ^ or $, or a literal. +atom :: Parsing.Parser Regex.Atom +atom = + Parsers.choice [ + Parsers.map (\g -> Regex.AtomGroup g) (Parsers.between (Parsers.char 40) (Parsers.char 41) (Parsers.lazy (\_ -> alternation))), + characterClass, + (Parsers.bind (Parsers.char 46) (\_ -> Parsers.pure Regex.AtomAny)), + (Parsers.bind (Parsers.char 94) (\_ -> Parsers.pure Regex.AtomAnchorStart)), + (Parsers.bind (Parsers.char 36) (\_ -> Parsers.pure Regex.AtomAnchorEnd)), + literalAtom] + +-- | Parse a character class [ ... ] or [^ ... ]; the class must be non-empty. +characterClass :: Parsing.Parser Regex.Atom +characterClass = + Parsers.bind (Parsers.char 91) (\_ -> Parsers.bind (Parsers.optional (Parsers.char 94)) (\neg -> Parsers.bind (Parsers.some classItem) (\items -> Parsers.bind (Parsers.char 93) (\_2 -> Parsers.pure (Regex.AtomClass (Regex.CharacterClass { + Regex.characterClassNegated = (Optionals.cases neg False (\_3 -> True)), + Regex.characterClassItems = items})))))) + +-- | Parse one member of a character class: a range like a-z, or a single character (escapes allowed). +classItem :: Parsing.Parser Regex.ClassItem +classItem = + Parsers.bind classChar (\from -> Parsers.alt (Parsers.bind (Parsers.char 45) (\_ -> Parsers.map (\to -> Regex.ClassItemRange (Regex.CharacterRange { + Regex.characterRangeFrom = from, + Regex.characterRangeTo = to})) classChar)) (Parsers.pure (Regex.ClassItemCharacter from))) + where + classChar = + Parsers.alt escapedChar (Parsers.satisfy (\c -> Logic.and (Logic.not (Equality.equal c 93)) (Logic.not (Equality.equal c 92)))) + +-- | Parse a backslash followed by any character; yields that character's codepoint (the escape is consumed). +escapedChar :: Parsing.Parser Int +escapedChar = Parsers.bind (Parsers.char 92) (\_ -> Parsers.anyChar) + +-- | True if the codepoint is a top-level regex metacharacter that must be escaped to match literally. +isMetachar :: Int -> Bool +isMetachar c = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 46, + 94, + 36, + 42, + 43, + 63, + 40, + 41, + 91, + 93, + 123, + 125, + 124, + 92] + +-- | Parse a literal character (an escaped metacharacter, or any ordinary non-metacharacter) into an Atom. +literalAtom :: Parsing.Parser Regex.Atom +literalAtom = + Parsers.map (\c -> Regex.AtomLiteral c) (Parsers.alt escapedChar (Parsers.satisfy (\c -> Logic.not (isMetachar c)))) + +-- | Parse a full regex pattern string into a hydra.regex AST. Returns nothing if the pattern is ill-formed or does not consume all input; a well-formed pattern is exactly one that parses here, so 'well-formed' is portable across all hosts. +parseRegex :: String -> Maybe [[Regex.Quantified]] +parseRegex input = + (\x -> case x of + Parsing.ParseResultSuccess v0 -> Logic.ifElse (Equality.equal (Parsing.parseSuccessRemainder v0) "") (Just (Parsing.parseSuccessValue v0)) Nothing + Parsing.ParseResultFailure _ -> Nothing) (Parsers.runParser regex input) + +-- | Parse an atom followed by an optional quantifier. +quantified :: Parsing.Parser Regex.Quantified +quantified = + Parsers.bind atom (\a -> Parsers.map (\q -> Regex.Quantified { + Regex.quantifiedAtom = a, + Regex.quantifiedQuantifier = q}) quantifier) + +-- | Parse an optional quantifier following an atom; yields 'one' when no quantifier is present. +quantifier :: Parsing.Parser Regex.Quantifier +quantifier = + Parsers.alt (Parsers.choice [ + Parsers.bind (Parsers.char 42) (\_ -> Parsers.pure Regex.QuantifierZeroOrMore), + (Parsers.bind (Parsers.char 43) (\_ -> Parsers.pure Regex.QuantifierOneOrMore)), + (Parsers.bind (Parsers.char 63) (\_ -> Parsers.pure Regex.QuantifierZeroOrOne)), + (Parsers.bind (Parsers.char 123) (\_ -> Parsers.bind unsignedInt (\n -> Parsers.bind (Parsers.optional (Parsers.char 44)) (\comma -> Optionals.cases comma (Parsers.bind (Parsers.char 125) (\_2 -> Parsers.pure (Regex.QuantifierExactly n))) (\_2 -> Parsers.bind (Parsers.optional unsignedInt) (\mm -> Parsers.bind (Parsers.char 125) (\_3 -> Optionals.cases mm (Parsers.pure (Regex.QuantifierAtLeast n)) (\m -> Parsers.pure (Regex.QuantifierRange_ (Regex.QuantifierRange { + Regex.quantifierRangeMin = n, + Regex.quantifierRangeMax = m}))))))))))]) (Parsers.pure Regex.QuantifierOne) + +-- | Parse a complete regex (an alternation). The empty pattern parses to a single empty sequence. +regex :: Parsing.Parser [[Regex.Quantified]] +regex = alternation + +-- | Parse a sequence of quantified atoms (a single alternation branch). May be empty only as the whole pattern; as an alternation branch it is constrained to be non-empty by the alternation parser's use of sepBy1 plus a non-empty check. +regexSequence :: Parsing.Parser [Regex.Quantified] +regexSequence = Parsers.many quantified + +-- | Parse a non-negative decimal integer (one or more digits). +unsignedInt :: Parsing.Parser Int +unsignedInt = + Parsers.map (\digits -> Lists.foldl (\acc -> \d -> Math.add (Math.mul acc 10) (Math.sub d 48)) 0 digits) (Parsers.some (Parsers.satisfy (\c -> Logic.and (Ordering.gte c 48) (Ordering.lte c 57)))) diff --git a/src/main/haskell/Hydra/Parsers.hs b/src/main/haskell/Hydra/Parsers.hs --- a/src/main/haskell/Hydra/Parsers.hs +++ b/src/main/haskell/Hydra/Parsers.hs @@ -26,6 +26,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -148,7 +149,7 @@ let parse = \input -> let codes = Strings.toList input - in (Optionals.cases (Lists.maybeHead codes) (Parsing.ParseResultFailure (Parsing.ParseError { + in (Optionals.cases (Lists.head codes) (Parsing.ParseResultFailure (Parsing.ParseError { Parsing.parseErrorMessage = "unexpected end of input", Parsing.parseErrorRemainder = input})) (\c -> let rest = Strings.fromList (Lists.drop 1 codes) @@ -182,5 +183,5 @@ in (Logic.ifElse (Equality.equal strCodes inputPrefix) (Parsing.ParseResultSuccess (Parsing.ParseSuccess { Parsing.parseSuccessValue = str, Parsing.parseSuccessRemainder = (Strings.fromList (Lists.drop strLen inputCodes))})) (Parsing.ParseResultFailure (Parsing.ParseError { - Parsing.parseErrorMessage = (Strings.cat2 "expected: " str), + Parsing.parseErrorMessage = (Strings.concat2 "expected: " str), Parsing.parseErrorRemainder = input})))) diff --git a/src/main/haskell/Hydra/Predicates.hs b/src/main/haskell/Hydra/Predicates.hs --- a/src/main/haskell/Hydra/Predicates.hs +++ b/src/main/haskell/Hydra/Predicates.hs @@ -23,10 +23,12 @@ import qualified Hydra.Lexical as Lexical import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Functions as Functions import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings @@ -35,6 +37,7 @@ import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Scoping as Scoping @@ -61,7 +64,7 @@ mts = Core.bindingTypeScheme b in (Optionals.cases mts (isComplexTerm tc term) (\ts -> let isPolymorphic = Logic.not (Lists.null (Core.typeSchemeVariables ts)) - isNonNullary = Equality.gt (Arity.typeArity (Core.typeSchemeBody ts)) 0 + isNonNullary = Ordering.gt (Arity.typeArity (Core.typeSchemeBody ts)) 0 isComplex = isComplexTerm tc term in (Logic.or (Logic.or isPolymorphic isNonNullary) isComplex))) @@ -84,7 +87,7 @@ let typeLookup = Maps.lookup name (Graph.graphBoundTypes tc) in (Optionals.cases typeLookup ( let primLookup = Maps.lookup name (Graph.graphPrimitives tc) - in (Optionals.cases primLookup True (\prim -> Equality.gt (Arity.typeSchemeArity (Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition prim)))) 0))) (\ts -> Equality.gt (Arity.typeSchemeArity ts) 0))))) + in (Optionals.cases primLookup True (\prim -> Ordering.gt (Arity.typeSchemeArity (Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition prim)))) 0))) (\ts -> Ordering.gt (Arity.typeSchemeArity ts) 0))))) -- | Determines whether a given term is an encoded term (meta-level term) isEncodedTerm :: Core.Term -> Bool @@ -132,7 +135,7 @@ \typ -> Lists.map Reflect.typeVariant (Rewriting.foldOverType Coders.TraversalOrderPre (\m -> \t -> Lists.cons t m) [] typ) in (Eithers.map (\deps -> let allVariants = Sets.fromList (Lists.concat (Lists.map variants (Maps.elems deps))) - in (Logic.not (Logic.or (Sets.member Variants.TypeVariantEffect allVariants) (Sets.member Variants.TypeVariantFunction allVariants)))) (typeDependencies cx graph False Equality.identity (Core.bindingName el))) + in (Logic.not (Logic.or (Sets.member Variants.TypeVariantEffect allVariants) (Sets.member Variants.TypeVariantFunction allVariants)))) (typeDependencies cx graph False Functions.identity (Core.bindingName el))) -- | Check if a type (by name) is serializable, resolving all type dependencies (Either version) isSerializableByName :: t0 -> Graph.Graph -> Core.Name -> Either Errors.Error Bool @@ -142,7 +145,7 @@ \typ -> Lists.map Reflect.typeVariant (Rewriting.foldOverType Coders.TraversalOrderPre (\m -> \t -> Lists.cons t m) [] typ) in (Eithers.map (\deps -> let allVariants = Sets.fromList (Lists.concat (Lists.map variants (Maps.elems deps))) - in (Logic.not (Logic.or (Sets.member Variants.TypeVariantEffect allVariants) (Sets.member Variants.TypeVariantFunction allVariants)))) (typeDependencies cx graph False Equality.identity name)) + in (Logic.not (Logic.or (Sets.member Variants.TypeVariantEffect allVariants) (Sets.member Variants.TypeVariantFunction allVariants)))) (typeDependencies cx graph False Functions.identity name)) -- | Check if a type is serializable (no function types in the type itself) isSerializableType :: Core.Type -> Bool diff --git a/src/main/haskell/Hydra/Print/Core.hs b/src/main/haskell/Hydra/Print/Core.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Core.hs @@ -0,0 +1,536 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.core types + +module Hydra.Print.Core where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | Show a binding as a string +binding :: Core.Binding -> String +binding el = + + let name = Core.unName (Core.bindingName el) + t = Core.bindingTerm el + typeStr = + Optionals.cases (Core.bindingTypeScheme el) "" (\ts -> Strings.concat [ + ":(", + (typeScheme ts), + ")"]) + in (Strings.concat [ + name, + typeStr, + " = ", + (term t)]) + +-- | Show a case statement as a string +caseStatement :: Core.CaseStatement -> String +caseStatement cs = + + let tname = Core.unName (Core.caseStatementTypeName cs) + mdef = Core.caseStatementDefault cs + csCases = Core.caseStatementCases cs + caseFields = + Lists.map (\alt -> Core.Field { + Core.fieldName = (Core.caseAlternativeName alt), + Core.fieldTerm = (Core.caseAlternativeHandler alt)}) csCases + defaultField = + Optionals.cases mdef [] (\d -> [ + Core.Field { + Core.fieldName = (Core.Name "[default]"), + Core.fieldTerm = d}]) + allFields = + Lists.concat [ + caseFields, + defaultField] + in (Strings.concat [ + "case(", + tname, + ")", + (fields allFields)]) + +-- | Show an Either value using given functions for left and right +either :: (t0 -> String) -> (t1 -> String) -> Either t0 t1 -> String +either showA showB e = + Eithers.either (\a -> Strings.concat2 "left(" (Strings.concat2 (showA a) ")")) (\b -> Strings.concat2 "right(" (Strings.concat2 (showB b) ")")) e + +-- | Show a field as a string +field :: Core.Field -> String +field field = + + let fname = Core.unName (Core.fieldName field) + fterm = Core.fieldTerm field + in (Strings.concat [ + fname, + "=", + (term fterm)]) + +-- | Show a field type as a string +fieldType :: Core.FieldType -> String +fieldType ft = + + let fname = Core.unName (Core.fieldTypeName ft) + ftyp = Core.fieldTypeType ft + in (Strings.concat [ + fname, + ":", + (type_ ftyp)]) + +-- | Show a list of fields as a string +fields :: [Core.Field] -> String +fields flds = + + let fieldStrs = Lists.map field flds + in (Strings.concat [ + "{", + (Strings.join ", " fieldStrs), + "}"]) + +-- | Show a float value as a string +float :: Core.FloatValue -> String +float fv = + case fv of + Core.FloatValueFloat32 v0 -> Strings.concat2 (Literals.showFloat32 v0) ":float32" + Core.FloatValueFloat64 v0 -> Strings.concat2 (Literals.showFloat64 v0) ":float64" + +-- | Show a float type as a string +floatType :: Core.FloatType -> String +floatType ft = + case ft of + Core.FloatTypeFloat32 -> "float32" + Core.FloatTypeFloat64 -> "float64" + +-- | Show an injection as a string +injection :: Core.Injection -> String +injection inj = + + let tname = Core.injectionTypeName inj + f = Core.injectionField inj + in (Strings.concat [ + "inject(", + (Core.unName tname), + ")", + (fields [ + f])]) + +-- | Show an integer value as a string +integer :: Core.IntegerValue -> String +integer iv = + case iv of + Core.IntegerValueBigint v0 -> Strings.concat2 (Literals.showBigint v0) ":bigint" + Core.IntegerValueInt8 v0 -> Strings.concat2 (Literals.showInt8 v0) ":int8" + Core.IntegerValueInt16 v0 -> Strings.concat2 (Literals.showInt16 v0) ":int16" + Core.IntegerValueInt32 v0 -> Strings.concat2 (Literals.showInt32 v0) ":int32" + Core.IntegerValueInt64 v0 -> Strings.concat2 (Literals.showInt64 v0) ":int64" + Core.IntegerValueUint8 v0 -> Strings.concat2 (Literals.showUint8 v0) ":uint8" + Core.IntegerValueUint16 v0 -> Strings.concat2 (Literals.showUint16 v0) ":uint16" + Core.IntegerValueUint32 v0 -> Strings.concat2 (Literals.showUint32 v0) ":uint32" + Core.IntegerValueUint64 v0 -> Strings.concat2 (Literals.showUint64 v0) ":uint64" + +-- | Show an integer type as a string +integerType :: Core.IntegerType -> String +integerType it = + case it of + Core.IntegerTypeBigint -> "bigint" + Core.IntegerTypeInt8 -> "int8" + Core.IntegerTypeInt16 -> "int16" + Core.IntegerTypeInt32 -> "int32" + Core.IntegerTypeInt64 -> "int64" + Core.IntegerTypeUint8 -> "uint8" + Core.IntegerTypeUint16 -> "uint16" + Core.IntegerTypeUint32 -> "uint32" + Core.IntegerTypeUint64 -> "uint64" + +-- | Show a lambda as a string +lambda :: Core.Lambda -> String +lambda l = + + let v = Core.unName (Core.lambdaParameter l) + mt = Core.lambdaDomain l + body = Core.lambdaBody l + typeStr = Optionals.cases mt "" (\t -> Strings.concat2 ":" (type_ t)) + in (Strings.concat [ + "\955", + v, + typeStr, + ".", + (term body)]) + +-- | Show a let expression as a string +let_ :: Core.Let -> String +let_ l = + + let bindings = Core.letBindings l + env = Core.letBody l + bindingStrs = Lists.map binding bindings + in (Strings.concat [ + "let ", + (Strings.join ", " bindingStrs), + " in ", + (term env)]) + +-- | Show a list using a given function to show each element +list :: (t0 -> String) -> [t0] -> String +list f xs = + + let elementStrs = Lists.map f xs + in (Strings.concat [ + "[", + (Strings.join ", " elementStrs), + "]"]) + +-- | Show a literal as a string +literal :: Core.Literal -> String +literal l = + case l of + Core.LiteralBinary _ -> "[binary]" + Core.LiteralBoolean v0 -> Logic.ifElse v0 "true" "false" + Core.LiteralDecimal v0 -> Literals.showDecimal v0 + Core.LiteralFloat v0 -> float v0 + Core.LiteralInteger v0 -> integer v0 + Core.LiteralString v0 -> Literals.printString v0 + +-- | Show a literal type as a string +literalType :: Core.LiteralType -> String +literalType lt = + case lt of + Core.LiteralTypeBinary -> "binary" + Core.LiteralTypeBoolean -> "boolean" + Core.LiteralTypeDecimal -> "decimal" + Core.LiteralTypeFloat v0 -> floatType v0 + Core.LiteralTypeInteger v0 -> integerType v0 + Core.LiteralTypeString -> "string" + +-- | Show a map using given functions to show keys and values +map :: Ord t0 => ((t0 -> String) -> (t1 -> String) -> M.Map t0 t1 -> String) +map showK showV m = + + let pairStrs = + Lists.map (\p -> Strings.concat [ + showK (Pairs.first p), + ": ", + (showV (Pairs.second p))]) (Maps.toList m) + in (Strings.concat [ + "{", + (Strings.join ", " pairStrs), + "}"]) + +-- | Show an optional value using a given function to show the element +optional :: (t0 -> String) -> Maybe t0 -> String +optional f mx = Optionals.cases mx "none" (\x -> Strings.concat2 "given(" (Strings.concat2 (f x) ")")) + +-- | Show a pair using given functions to show each element +pair :: (t0 -> String) -> (t1 -> String) -> (t0, t1) -> String +pair showA showB p = + Strings.concat [ + "(", + (showA (Pairs.first p)), + ", ", + (showB (Pairs.second p)), + ")"] + +-- | Show a projection as a string +projection :: Core.Projection -> String +projection proj = + + let tname = Core.unName (Core.projectionTypeName proj) + fname = Core.unName (Core.projectionFieldName proj) + in (Strings.concat [ + "project(", + tname, + "){", + fname, + "}"]) + +-- | A placeholder for reading terms from their serialized form. Not implemented. +readTerm :: String -> Maybe Core.Term +readTerm s = Just (Core.TermLiteral (Core.LiteralString s)) + +-- | Show a set using a given function to show each element +set :: Ord t0 => ((t0 -> String) -> S.Set t0 -> String) +set f xs = + + let elementStrs = Lists.map f (Sets.toList xs) + in (Strings.concat [ + "{", + (Strings.join ", " elementStrs), + "}"]) + +-- | Show a term as a string +term :: Core.Term -> String +term t = + + let gatherTerms = + \prev -> \app -> + let lhs = Core.applicationFunction app + rhs = Core.applicationArgument app + in case lhs of + Core.TermApplication v0 -> gatherTerms (Lists.cons rhs prev) v0 + _ -> Lists.cons lhs (Lists.cons rhs prev) + in case t of + Core.TermAnnotated v0 -> term (Core.annotatedTermBody v0) + Core.TermApplication v0 -> + let terms = gatherTerms [] v0 + termStrs = Lists.map term terms + in (Strings.concat [ + "(", + (Strings.join " @ " termStrs), + ")"]) + Core.TermCases v0 -> caseStatement v0 + Core.TermEither v0 -> Eithers.either (\l -> Strings.concat [ + "left(", + (term l), + ")"]) (\r -> Strings.concat [ + "right(", + (term r), + ")"]) v0 + Core.TermLambda v0 -> lambda v0 + Core.TermLet v0 -> let_ v0 + Core.TermList v0 -> + let termStrs = Lists.map term v0 + in (Strings.concat [ + "[", + (Strings.join ", " termStrs), + "]"]) + Core.TermLiteral v0 -> literal v0 + Core.TermMap v0 -> + let entry = + \p -> Strings.concat [ + term (Pairs.first p), + "=", + (term (Pairs.second p))] + in (Strings.concat [ + "{", + (Strings.join ", " (Lists.map entry (Maps.toList v0))), + "}"]) + Core.TermOptional v0 -> Optionals.cases v0 "none" (\t2 -> Strings.concat [ + "given(", + (term t2), + ")"]) + Core.TermPair v0 -> Strings.concat [ + "(", + (term (Pairs.first v0)), + ", ", + (term (Pairs.second v0)), + ")"] + Core.TermProject v0 -> projection v0 + Core.TermRecord v0 -> + let tname = Core.unName (Core.recordTypeName v0) + flds = Core.recordFields v0 + in (Strings.concat [ + "record(", + tname, + ")", + (fields flds)]) + Core.TermSet v0 -> Strings.concat [ + "{", + (Strings.join ", " (Lists.map term (Sets.toList v0))), + "}"] + Core.TermTypeLambda v0 -> + let param = Core.unName (Core.typeLambdaParameter v0) + body = Core.typeLambdaBody v0 + in (Strings.concat [ + "\923", + param, + ".", + (term body)]) + Core.TermTypeApplication v0 -> + let t2 = Core.typeApplicationTermBody v0 + typ = Core.typeApplicationTermType v0 + in (Strings.concat [ + term t2, + "\10216", + (type_ typ), + "\10217"]) + Core.TermInject v0 -> injection v0 + Core.TermUnit -> "unit" + Core.TermUnwrap v0 -> Strings.concat [ + "unwrap(", + (Core.unName v0), + ")"] + Core.TermVariable v0 -> Core.unName v0 + Core.TermWrap v0 -> + let tname = Core.unName (Core.wrappedTermTypeName v0) + term1 = Core.wrappedTermBody v0 + in (Strings.concat [ + "wrap(", + tname, + "){", + (term term1), + "}"]) + +-- | Show a type as a string +type_ :: Core.Type -> String +type_ typ = + + let showRowType = + \flds -> + let fieldStrs = Lists.map fieldType flds + in (Strings.concat [ + "{", + (Strings.join ", " fieldStrs), + "}"]) + gatherTypes = + \prev -> \app -> + let lhs = Core.applicationTypeFunction app + rhs = Core.applicationTypeArgument app + in case lhs of + Core.TypeApplication v0 -> gatherTypes (Lists.cons rhs prev) v0 + _ -> Lists.cons lhs (Lists.cons rhs prev) + gatherFunctionTypes = + \prev -> \t -> case t of + Core.TypeFunction v0 -> + let dom = Core.functionTypeDomain v0 + cod = Core.functionTypeCodomain v0 + in (gatherFunctionTypes (Lists.cons dom prev) cod) + _ -> Lists.reverse (Lists.cons t prev) + in case typ of + Core.TypeAnnotated v0 -> type_ (Core.annotatedTypeBody v0) + Core.TypeApplication v0 -> + let types = gatherTypes [] v0 + typeStrs = Lists.map type_ types + in (Strings.concat [ + "(", + (Strings.join " @ " typeStrs), + ")"]) + Core.TypeEffect v0 -> Strings.concat [ + "effect<", + (type_ v0), + ">"] + Core.TypeEither v0 -> + let leftTyp = Core.eitherTypeLeft v0 + rightTyp = Core.eitherTypeRight v0 + in (Strings.concat [ + "either<", + (type_ leftTyp), + ", ", + (type_ rightTyp), + ">"]) + Core.TypeForall v0 -> + let var = Core.unName (Core.forallTypeParameter v0) + body = Core.forallTypeBody v0 + in (Strings.concat [ + "(\8704", + var, + ".", + (type_ body), + ")"]) + Core.TypeFunction _ -> + let types = gatherFunctionTypes [] typ + typeStrs = Lists.map type_ types + in (Strings.concat [ + "(", + (Strings.join " \8594 " typeStrs), + ")"]) + Core.TypeList v0 -> Strings.concat [ + "list<", + (type_ v0), + ">"] + Core.TypeLiteral v0 -> literalType v0 + Core.TypeMap v0 -> + let keyTyp = Core.mapTypeKeys v0 + valTyp = Core.mapTypeValues v0 + in (Strings.concat [ + "map<", + (type_ keyTyp), + ", ", + (type_ valTyp), + ">"]) + Core.TypeOptional v0 -> Strings.concat [ + "optional<", + (type_ v0), + ">"] + Core.TypePair v0 -> + let firstTyp = Core.pairTypeFirst v0 + secondTyp = Core.pairTypeSecond v0 + in (Strings.concat [ + "(", + (type_ firstTyp), + ", ", + (type_ secondTyp), + ")"]) + Core.TypeRecord v0 -> Strings.concat2 "record" (showRowType v0) + Core.TypeSet v0 -> Strings.concat [ + "set<", + (type_ v0), + ">"] + Core.TypeUnion v0 -> Strings.concat2 "union" (showRowType v0) + Core.TypeUnit -> "unit" + Core.TypeVariable v0 -> Core.unName v0 + Core.TypeVoid -> "void" + Core.TypeWrap v0 -> Strings.concat [ + "wrap(", + (type_ v0), + ")"] + +-- | Show a type scheme as a string +typeScheme :: Core.TypeScheme -> String +typeScheme ts = + + let vars = Core.typeSchemeVariables ts + body = Core.typeSchemeBody ts + varNames = Lists.map Core.unName vars + fa = + Logic.ifElse (Lists.null vars) "" (Strings.concat [ + "forall ", + (Strings.join "," varNames), + ". "]) + toConstraintPair = + \v -> \c -> Strings.concat [ + case c of + Core.TypeClassConstraintSimple v0 -> Core.unName v0, + " ", + (Core.unName v)] + toConstraintPairs = + \p -> Lists.map (toConstraintPair (Pairs.first p)) (Core.typeVariableConstraintsClasses (Pairs.second p)) + tc = Optionals.cases (Core.typeSchemeConstraints ts) [] (\m -> Lists.concat (Lists.map toConstraintPairs (Maps.toList m))) + in (Strings.concat [ + "(", + fa, + (Logic.ifElse (Lists.null tc) "" (Strings.concat [ + "(", + (Strings.join ", " tc), + ") => "])), + (type_ body), + ")"]) diff --git a/src/main/haskell/Hydra/Print/Docs.hs b/src/main/haskell/Hydra/Print/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Docs.hs @@ -0,0 +1,88 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.docs types + +module Hydra.Print.Docs where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parse.Docs as ParseDocs +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Render a DefinitionReference as its fully-qualified name +definitionReference :: Packaging.DefinitionReference -> String +definitionReference x = + case x of + Packaging.DefinitionReferencePrimitive v0 -> Core.unName v0 + Packaging.DefinitionReferenceTerm v0 -> Core.unName v0 + Packaging.DefinitionReferenceType v0 -> Core.unName v0 + +-- | Render a single DocSegment back to its source string form +docSegment :: Docs.DocSegment -> String +docSegment seg = docSegmentWith entityReference seg + +-- | Render a single DocSegment using a custom 'EntityReference' renderer +docSegmentWith :: (Packaging.EntityReference -> String) -> Docs.DocSegment -> String +docSegmentWith render x = + case x of + Docs.DocSegmentRef v0 -> render v0 + Docs.DocSegmentText v0 -> v0 + +-- | Render a list of DocSegments back to a plain documentation string +docSegments :: [Docs.DocSegment] -> String +docSegments segs = Strings.concat (Lists.map docSegment segs) + +-- | Render a list of DocSegments using a custom 'EntityReference' renderer +docSegmentsWith :: (Packaging.EntityReference -> String) -> [Docs.DocSegment] -> String +docSegmentsWith render segs = Strings.concat (Lists.map (docSegmentWith render) segs) + +-- | Render a 'EntityReference' as its doc-escape tag string (without the surrounding braces) +entityReference :: Packaging.EntityReference -> String +entityReference x = + case x of + Packaging.EntityReferenceDefinition v0 -> Strings.concat2 (case v0 of + Packaging.DefinitionReferencePrimitive _ -> "primitive" + Packaging.DefinitionReferenceTerm _ -> "term" + Packaging.DefinitionReferenceType _ -> "type") (Strings.concat2 " " (definitionReference v0)) + Packaging.EntityReferenceModule v0 -> Strings.concat2 "module " (Packaging.unModuleName v0) + Packaging.EntityReferencePackage v0 -> Strings.concat2 "package " (Packaging.unPackageName v0) + Packaging.EntityReferenceTermExpr v0 -> Strings.concat2 "term-expr " v0 + Packaging.EntityReferenceTypeExpr v0 -> Strings.concat2 "type-expr " v0 + +-- | Parse a documentation string and re-render it, converting doc-escape tags through their canonical form +renderDocString :: String -> String +renderDocString s = renderDocStringWith entityReference s + +-- | Parse a documentation string and render it using a custom 'EntityReference' renderer. Text segments are passed through; ref segments are rendered by the provided function. Unrecognized doc-escape blocks are passed through as text. +renderDocStringWith :: (Packaging.EntityReference -> String) -> String -> String +renderDocStringWith render s = docSegmentsWith render (ParseDocs.parseDocString s) diff --git a/src/main/haskell/Hydra/Print/Emacs/Regex.hs b/src/main/haskell/Hydra/Print/Emacs/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Emacs/Regex.hs @@ -0,0 +1,152 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Per-dialect printer rendering the hydra.regex AST into GNU Emacs regexp syntax. Emacs inverts several escaping conventions relative to POSIX ERE (probe-verified, Emacs 28.2): alternation is \| (bare | is literal), grouping is \( \) (bare ( ) are literal), and bounded quantifiers are \{n,m\} (bare braces are literal). The quantifiers * + ? are bare as usual, and character classes are POSIX-like. Hydra's . (any incl. newline) renders as [^z-a] — an empty negated range that matches every character including newline (Emacs . excludes newline). See docs/specification/regex.md and issue #567. + +module Hydra.Print.Emacs.Regex where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Render an alternation, joining its branches with Emacs's \| operator. +alternation :: [[Regex.Quantified]] -> String +alternation alt = Strings.join "\\|" (Lists.map regexSequence alt) + +-- | The Emacs rendering of Hydra's . (any character incl. newline): the empty-negated-range [^z-a]. +anyClass :: String +anyClass = "[^z-a]" + +-- | Render a single atom; . -> [^z-a], and groups use Emacs's \( \) escaping. +atom :: Regex.Atom -> String +atom a = + case a of + Regex.AtomLiteral v0 -> escapeLiteral v0 + Regex.AtomAny -> anyClass + Regex.AtomAnchorStart -> "^" + Regex.AtomAnchorEnd -> "$" + Regex.AtomGroup v0 -> Strings.concat [ + "\\(", + (alternation v0), + "\\)"] + Regex.AtomClass v0 -> characterClass v0 + +-- | Render a character class, including the leading ^ for a negated class (POSIX-like in Emacs). +characterClass :: Regex.CharacterClass -> String +characterClass cc = + Strings.concat [ + "[", + (Logic.ifElse (Regex.characterClassNegated cc) "^" ""), + (Strings.concat (Lists.map classItem (Regex.characterClassItems cc))), + "]"] + +-- | Render one character-class member (a single character or an inclusive range). +classItem :: Regex.ClassItem -> String +classItem item = + case item of + Regex.ClassItemCharacter v0 -> escapeClassChar v0 + Regex.ClassItemRange v0 -> Strings.concat [ + escapeClassChar (Regex.characterRangeFrom v0), + "-", + (escapeClassChar (Regex.characterRangeTo v0))] + +-- | Render a code point inside a character class, uniformly escaping the class metacharacters \ ] ^ -. +escapeClassChar :: Int -> String +escapeClassChar c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 92, + 93, + 94, + 45] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a literal code point in top-level context under Emacs regexp, escaping only the characters that are special bare in Emacs: . * + ? [ ] ^ $ \. Note | ( ) { } are literal in Emacs and are NOT escaped here. +escapeLiteral :: Int -> String +escapeLiteral c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 46, + 42, + 43, + 63, + 91, + 93, + 94, + 36, + 92] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a hydra.regex AST into GNU Emacs regexp syntax (escaped \| \( \) \{..\}, . as [^z-a]). +printRegex :: [[Regex.Quantified]] -> String +printRegex r = alternation r + +-- | Render an atom followed by its quantifier suffix. +quantified :: Regex.Quantified -> String +quantified qa = Strings.concat2 (atom (Regex.quantifiedAtom qa)) (quantifier (Regex.quantifiedQuantifier qa)) + +-- | Render a quantifier suffix; bounded {..} forms use Emacs's escaped braces \{..\}. +quantifier :: Regex.Quantifier -> String +quantifier q = + case q of + Regex.QuantifierOne -> "" + Regex.QuantifierZeroOrOne -> "?" + Regex.QuantifierZeroOrMore -> "*" + Regex.QuantifierOneOrMore -> "+" + Regex.QuantifierExactly v0 -> Strings.concat [ + "\\{", + (Literals.showInt32 v0), + "\\}"] + Regex.QuantifierAtLeast v0 -> Strings.concat [ + "\\{", + (Literals.showInt32 v0), + ",\\}"] + Regex.QuantifierRange_ v0 -> Strings.concat [ + "\\{", + (Literals.showInt32 (Regex.quantifierRangeMin v0)), + ",", + (Literals.showInt32 (Regex.quantifierRangeMax v0)), + "\\}"] + +-- | Render a sequence of quantified atoms by concatenation. +regexSequence :: [Regex.Quantified] -> String +regexSequence s = Strings.concat (Lists.map quantified s) + +-- | Render a single Unicode code point as a one-character string. +showCodePoint :: Int -> String +showCodePoint c = Strings.fromList [ + c] diff --git a/src/main/haskell/Hydra/Print/Error/Core.hs b/src/main/haskell/Hydra/Print/Error/Core.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Error/Core.hs @@ -0,0 +1,373 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.error.core types + +module Hydra.Print.Error.Core where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Variants as PrintVariants +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a constant condition error as a string +constantConditionError :: ErrorCore.ConstantConditionError -> String +constantConditionError e = + Strings.concat [ + "constant condition: ifElse with literal ", + (Literals.printBoolean (ErrorCore.constantConditionErrorValue e))] + +-- | Show a duplicate binding error as a string +duplicateBindingError :: ErrorCore.DuplicateBindingError -> String +duplicateBindingError e = + Strings.concat [ + "duplicate binding: ", + (Core.unName (ErrorCore.duplicateBindingErrorName e))] + +-- | Show a duplicate field error as a string +duplicateFieldError :: ErrorCore.DuplicateFieldError -> String +duplicateFieldError e = + Strings.concat [ + "duplicate field: ", + (Core.unName (ErrorCore.duplicateFieldErrorName e))] + +-- | Show a duplicate record type field names error as a string +duplicateRecordTypeFieldNamesError :: ErrorCore.DuplicateRecordTypeFieldNamesError -> String +duplicateRecordTypeFieldNamesError e = + Strings.concat [ + "duplicate field in record type: ", + (Core.unName (ErrorCore.duplicateRecordTypeFieldNamesErrorName e))] + +-- | Show a duplicate union type field names error as a string +duplicateUnionTypeFieldNamesError :: ErrorCore.DuplicateUnionTypeFieldNamesError -> String +duplicateUnionTypeFieldNamesError e = + Strings.concat [ + "duplicate field in union type: ", + (Core.unName (ErrorCore.duplicateUnionTypeFieldNamesErrorName e))] + +-- | Show an empty case statement error as a string +emptyCaseStatementError :: ErrorCore.EmptyCaseStatementError -> String +emptyCaseStatementError e = + Strings.concat [ + "empty case statement for type: ", + (Core.unName (ErrorCore.emptyCaseStatementErrorTypeName e))] + +-- | Show an empty let bindings error as a string +emptyLetBindingsError :: t0 -> String +emptyLetBindingsError e = "let expression with no bindings" + +-- | Show an empty record type error as a string +emptyRecordTypeError :: t0 -> String +emptyRecordTypeError e = "record type with no fields (use TypeUnit instead)" + +-- | Show an empty term annotation error as a string +emptyTermAnnotationError :: t0 -> String +emptyTermAnnotationError e = "term annotation with empty annotation map" + +-- | Show an empty type annotation error as a string +emptyTypeAnnotationError :: t0 -> String +emptyTypeAnnotationError e = "type annotation with empty annotation map" + +-- | Show an empty type name in term error as a string +emptyTypeNameInTermError :: t0 -> String +emptyTypeNameInTermError e = "term with empty type name" + +-- | Show an empty union type error as a string +emptyUnionTypeError :: t0 -> String +emptyUnionTypeError e = "union type with no alternatives (use TypeVoid instead)" + +-- | Show an invalid forall parameter name error as a string +invalidForallParameterNameError :: ErrorCore.InvalidForallParameterNameError -> String +invalidForallParameterNameError e = + Strings.concat [ + "invalid forall parameter name: ", + (Core.unName (ErrorCore.invalidForallParameterNameErrorName e))] + +-- | Show an invalid lambda parameter name error as a string +invalidLambdaParameterNameError :: ErrorCore.InvalidLambdaParameterNameError -> String +invalidLambdaParameterNameError e = + Strings.concat [ + "invalid lambda parameter name: ", + (Core.unName (ErrorCore.invalidLambdaParameterNameErrorName e))] + +-- | Show an invalid let binding name error as a string +invalidLetBindingNameError :: ErrorCore.InvalidLetBindingNameError -> String +invalidLetBindingNameError e = + Strings.concat [ + "invalid let binding name: ", + (Core.unName (ErrorCore.invalidLetBindingNameErrorName e))] + +-- | Show an invalid term error as a string +invalidTermError :: ErrorCore.InvalidTermError -> String +invalidTermError e = + Strings.concat2 "invalid term: " (case e of + ErrorCore.InvalidTermErrorConstantCondition v0 -> constantConditionError v0 + ErrorCore.InvalidTermErrorDuplicateBinding v0 -> duplicateBindingError v0 + ErrorCore.InvalidTermErrorDuplicateField v0 -> duplicateFieldError v0 + ErrorCore.InvalidTermErrorEmptyCaseStatement v0 -> emptyCaseStatementError v0 + ErrorCore.InvalidTermErrorEmptyLetBindings v0 -> emptyLetBindingsError v0 + ErrorCore.InvalidTermErrorEmptyTermAnnotation v0 -> emptyTermAnnotationError v0 + ErrorCore.InvalidTermErrorEmptyTypeNameInTerm v0 -> emptyTypeNameInTermError v0 + ErrorCore.InvalidTermErrorInvalidLambdaParameterName v0 -> invalidLambdaParameterNameError v0 + ErrorCore.InvalidTermErrorInvalidLetBindingName v0 -> invalidLetBindingNameError v0 + ErrorCore.InvalidTermErrorInvalidTypeLambdaParameterName v0 -> invalidTypeLambdaParameterNameError v0 + ErrorCore.InvalidTermErrorMissingCaseBranches v0 -> missingCaseBranchesError v0 + ErrorCore.InvalidTermErrorNestedTermAnnotation v0 -> nestedTermAnnotationError v0 + ErrorCore.InvalidTermErrorRedundantWrapUnwrap v0 -> redundantWrapUnwrapError v0 + ErrorCore.InvalidTermErrorSelfApplication v0 -> selfApplicationError v0 + ErrorCore.InvalidTermErrorTermVariableShadowing v0 -> termVariableShadowingError v0 + ErrorCore.InvalidTermErrorTypeVariableShadowingInTypeLambda v0 -> typeVariableShadowingInTypeLambdaError v0 + ErrorCore.InvalidTermErrorUndefinedTermVariable v0 -> undefinedTermVariableError v0 + ErrorCore.InvalidTermErrorUndefinedTypeVariableInBindingType v0 -> undefinedTypeVariableInBindingTypeError v0 + ErrorCore.InvalidTermErrorUndefinedTypeVariableInLambdaDomain v0 -> undefinedTypeVariableInLambdaDomainError v0 + ErrorCore.InvalidTermErrorUndefinedTypeVariableInTypeApplication v0 -> undefinedTypeVariableInTypeApplicationError v0 + ErrorCore.InvalidTermErrorUnknownCaseAlternative v0 -> unknownCaseAlternativeError v0 + ErrorCore.InvalidTermErrorUnknownPrimitiveName v0 -> unknownPrimitiveNameError v0 + ErrorCore.InvalidTermErrorUnnecessaryIdentityApplication v0 -> unnecessaryIdentityApplicationError v0 + ErrorCore.InvalidTermErrorUntypedTermVariable v0 -> untypedTermVariableError v0) + +-- | Show an invalid type error as a string +invalidTypeError :: ErrorCore.InvalidTypeError -> String +invalidTypeError e = + Strings.concat2 "invalid type: " (case e of + ErrorCore.InvalidTypeErrorDuplicateRecordTypeFieldNames v0 -> duplicateRecordTypeFieldNamesError v0 + ErrorCore.InvalidTypeErrorDuplicateUnionTypeFieldNames v0 -> duplicateUnionTypeFieldNamesError v0 + ErrorCore.InvalidTypeErrorEmptyRecordType v0 -> emptyRecordTypeError v0 + ErrorCore.InvalidTypeErrorEmptyTypeAnnotation v0 -> emptyTypeAnnotationError v0 + ErrorCore.InvalidTypeErrorEmptyUnionType v0 -> emptyUnionTypeError v0 + ErrorCore.InvalidTypeErrorInvalidForallParameterName v0 -> invalidForallParameterNameError v0 + ErrorCore.InvalidTypeErrorInvalidTypeSchemeVariableName v0 -> invalidTypeSchemeVariableNameError v0 + ErrorCore.InvalidTypeErrorNestedTypeAnnotation v0 -> nestedTypeAnnotationError v0 + ErrorCore.InvalidTypeErrorNonComparableMapKeyType v0 -> nonComparableMapKeyTypeError v0 + ErrorCore.InvalidTypeErrorNonComparableSetElementType v0 -> nonComparableSetElementTypeError v0 + ErrorCore.InvalidTypeErrorSingleVariantUnion v0 -> singleVariantUnionError v0 + ErrorCore.InvalidTypeErrorTypeVariableShadowingInForall v0 -> typeVariableShadowingInForallError v0 + ErrorCore.InvalidTypeErrorUndefinedTypeVariable v0 -> undefinedTypeVariableError v0 + ErrorCore.InvalidTypeErrorVoidInNonBottomPosition v0 -> voidInNonBottomPositionError v0) + +-- | Show an invalid type lambda parameter name error as a string +invalidTypeLambdaParameterNameError :: ErrorCore.InvalidTypeLambdaParameterNameError -> String +invalidTypeLambdaParameterNameError e = + Strings.concat [ + "invalid type lambda parameter name: ", + (Core.unName (ErrorCore.invalidTypeLambdaParameterNameErrorName e))] + +-- | Show an invalid type scheme variable name error as a string +invalidTypeSchemeVariableNameError :: ErrorCore.InvalidTypeSchemeVariableNameError -> String +invalidTypeSchemeVariableNameError e = + Strings.concat [ + "invalid type scheme variable name: ", + (Core.unName (ErrorCore.invalidTypeSchemeVariableNameErrorName e))] + +-- | Show a missing case branches error as a string +missingCaseBranchesError :: ErrorCore.MissingCaseBranchesError -> String +missingCaseBranchesError e = + + let tname = ErrorCore.missingCaseBranchesErrorTypeName e + variantNames = ErrorCore.missingCaseBranchesErrorVariantNames e + in (Strings.concat [ + "case statement for type ", + (Core.unName tname), + " does not cover variant(s): ", + (Strings.join ", " (Lists.map Core.unName variantNames))]) + +-- | Show a nested term annotation error as a string +nestedTermAnnotationError :: t0 -> String +nestedTermAnnotationError e = "nested term annotations should be merged" + +-- | Show a nested type annotation error as a string +nestedTypeAnnotationError :: t0 -> String +nestedTypeAnnotationError e = "nested type annotations should be merged" + +-- | Show a non-comparable map key type error as a string +nonComparableMapKeyTypeError :: ErrorCore.NonComparableMapKeyTypeError -> String +nonComparableMapKeyTypeError e = + Strings.concat [ + "map key type contains a function type: ", + (PrintCore.type_ (ErrorCore.nonComparableMapKeyTypeErrorKeyType e))] + +-- | Show a non-comparable set element type error as a string +nonComparableSetElementTypeError :: ErrorCore.NonComparableSetElementTypeError -> String +nonComparableSetElementTypeError e = + Strings.concat [ + "set element type contains a function type: ", + (PrintCore.type_ (ErrorCore.nonComparableSetElementTypeErrorElementType e))] + +-- | Show a redundant wrap/unwrap error as a string +redundantWrapUnwrapError :: ErrorCore.RedundantWrapUnwrapError -> String +redundantWrapUnwrapError e = + Strings.concat [ + "redundant wrap/unwrap for type: ", + (Core.unName (ErrorCore.redundantWrapUnwrapErrorTypeName e))] + +-- | Show a self-application error as a string +selfApplicationError :: ErrorCore.SelfApplicationError -> String +selfApplicationError e = + Strings.concat [ + "self-application of variable: ", + (Core.unName (ErrorCore.selfApplicationErrorName e))] + +-- | Show a single variant union error as a string +singleVariantUnionError :: ErrorCore.SingleVariantUnionError -> String +singleVariantUnionError e = + Strings.concat [ + "union type with single variant: ", + (Core.unName (ErrorCore.singleVariantUnionErrorFieldName e))] + +-- | Show a term variable shadowing error as a string +termVariableShadowingError :: ErrorCore.TermVariableShadowingError -> String +termVariableShadowingError e = + Strings.concat [ + "variable shadowing: ", + (Core.unName (ErrorCore.termVariableShadowingErrorName e))] + +-- | Show a type variable shadowing in forall error as a string +typeVariableShadowingInForallError :: ErrorCore.TypeVariableShadowingInForallError -> String +typeVariableShadowingInForallError e = + Strings.concat [ + "type variable shadowing in forall: ", + (Core.unName (ErrorCore.typeVariableShadowingInForallErrorName e))] + +-- | Show a type variable shadowing in type lambda error as a string +typeVariableShadowingInTypeLambdaError :: ErrorCore.TypeVariableShadowingInTypeLambdaError -> String +typeVariableShadowingInTypeLambdaError e = + Strings.concat [ + "type variable shadowing in type lambda: ", + (Core.unName (ErrorCore.typeVariableShadowingInTypeLambdaErrorName e))] + +-- | Show an undefined field error as a string +undefinedFieldError :: ErrorCore.UndefinedFieldError -> String +undefinedFieldError e = + + let fname = ErrorCore.undefinedFieldErrorFieldName e + tname = ErrorCore.undefinedFieldErrorTypeName e + in (Strings.concat [ + "no such field \"", + (Core.unName fname), + "\" in type \"", + (Core.unName tname), + "\""]) + +-- | Show an undefined term variable error as a string +undefinedTermVariableError :: ErrorCore.UndefinedTermVariableError -> String +undefinedTermVariableError e = + Strings.concat [ + "undefined term variable: ", + (Core.unName (ErrorCore.undefinedTermVariableErrorName e))] + +-- | Show an undefined type variable error as a string +undefinedTypeVariableError :: ErrorCore.UndefinedTypeVariableError -> String +undefinedTypeVariableError e = + Strings.concat [ + "undefined type variable: ", + (Core.unName (ErrorCore.undefinedTypeVariableErrorName e))] + +-- | Show an undefined type variable in binding type error as a string +undefinedTypeVariableInBindingTypeError :: ErrorCore.UndefinedTypeVariableInBindingTypeError -> String +undefinedTypeVariableInBindingTypeError e = + Strings.concat [ + "undefined type variable in binding type: ", + (Core.unName (ErrorCore.undefinedTypeVariableInBindingTypeErrorName e))] + +-- | Show an undefined type variable in lambda domain error as a string +undefinedTypeVariableInLambdaDomainError :: ErrorCore.UndefinedTypeVariableInLambdaDomainError -> String +undefinedTypeVariableInLambdaDomainError e = + Strings.concat [ + "undefined type variable in lambda domain: ", + (Core.unName (ErrorCore.undefinedTypeVariableInLambdaDomainErrorName e))] + +-- | Show an undefined type variable in type application error as a string +undefinedTypeVariableInTypeApplicationError :: ErrorCore.UndefinedTypeVariableInTypeApplicationError -> String +undefinedTypeVariableInTypeApplicationError e = + Strings.concat [ + "undefined type variable in type application: ", + (Core.unName (ErrorCore.undefinedTypeVariableInTypeApplicationErrorName e))] + +-- | Show an unexpected term variant error as a string +unexpectedTermVariantError :: ErrorCore.UnexpectedTermVariantError -> String +unexpectedTermVariantError e = + + let expected = ErrorCore.unexpectedTermVariantErrorExpectedVariant e + actual = ErrorCore.unexpectedTermVariantErrorActualTerm e + in (Strings.concat [ + "expected ", + (PrintVariants.termVariant expected), + " term but found ", + (PrintCore.term actual)]) + +-- | Show an unexpected type variant error as a string +unexpectedTypeVariantError :: ErrorCore.UnexpectedTypeVariantError -> String +unexpectedTypeVariantError e = + + let expected = ErrorCore.unexpectedTypeVariantErrorExpectedVariant e + actual = ErrorCore.unexpectedTypeVariantErrorActualType e + in (Strings.concat [ + "expected ", + (PrintVariants.typeVariant expected), + " type but found ", + (PrintCore.type_ actual)]) + +-- | Show an unknown case alternative error as a string +unknownCaseAlternativeError :: ErrorCore.UnknownCaseAlternativeError -> String +unknownCaseAlternativeError e = + + let tname = ErrorCore.unknownCaseAlternativeErrorTypeName e + name = ErrorCore.unknownCaseAlternativeErrorName e + in (Strings.concat [ + "case alternative ", + (Core.unName name), + " is not a variant of type ", + (Core.unName tname)]) + +-- | Show an unknown primitive name error as a string +unknownPrimitiveNameError :: ErrorCore.UnknownPrimitiveNameError -> String +unknownPrimitiveNameError e = + Strings.concat [ + "unknown primitive: ", + (Core.unName (ErrorCore.unknownPrimitiveNameErrorName e))] + +-- | Show an unnecessary identity application error as a string +unnecessaryIdentityApplicationError :: t0 -> String +unnecessaryIdentityApplicationError e = "unnecessary application of identity lambda" + +-- | Show an untyped term variable error as a string +untypedTermVariableError :: ErrorCore.UntypedTermVariableError -> String +untypedTermVariableError e = + Strings.concat [ + "untyped term variable: ", + (Core.unName (ErrorCore.untypedTermVariableErrorName e))] + +-- | Show a void in non-bottom position error as a string +voidInNonBottomPositionError :: t0 -> String +voidInNonBottomPositionError e = "TypeVoid in a position where no value can be constructed" diff --git a/src/main/haskell/Hydra/Print/Error/Packaging.hs b/src/main/haskell/Hydra/Print/Error/Packaging.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Error/Packaging.hs @@ -0,0 +1,169 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.error.packaging types + +module Hydra.Print.Error.Packaging where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Util as PrintUtil +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a conflicting module namespace error as a string +conflictingModuleNameError :: ErrorPackaging.ConflictingModuleNameError -> String +conflictingModuleNameError e = + Strings.concat [ + "module namespaces conflict when mapped to target language path: ", + (Packaging.unModuleName (ErrorPackaging.conflictingModuleNameErrorFirst e)), + " vs ", + (Packaging.unModuleName (ErrorPackaging.conflictingModuleNameErrorSecond e))] + +-- | Show a conflicting variant name error as a string +conflictingVariantNameError :: ErrorPackaging.ConflictingVariantNameError -> String +conflictingVariantNameError e = + Strings.concat [ + "in module ", + (Packaging.unModuleName (ErrorPackaging.conflictingVariantNameErrorModuleName e)), + ": variant ", + (Core.unName (ErrorPackaging.conflictingVariantNameErrorVariantName e)), + " of type ", + (Core.unName (ErrorPackaging.conflictingVariantNameErrorTypeName e)), + " produces constructor name ", + (Core.unName (ErrorPackaging.conflictingVariantNameErrorConflictingName e)), + " which conflicts with another type definition"] + +-- | Show a definition-not-in-module-namespace error as a string +definitionNotInModuleNameError :: ErrorPackaging.DefinitionNotInModuleNameError -> String +definitionNotInModuleNameError e = + Strings.concat [ + "definition ", + (Core.unName (ErrorPackaging.definitionNotInModuleNameErrorName e)), + " is not in module namespace ", + (Packaging.unModuleName (ErrorPackaging.definitionNotInModuleNameErrorModuleName e))] + +-- | Show a definitions-out-of-order error as a string +definitionsOutOfOrderError :: ErrorPackaging.DefinitionsOutOfOrderError -> String +definitionsOutOfOrderError e = + Strings.concat [ + "in module ", + (Packaging.unModuleName (ErrorPackaging.definitionsOutOfOrderErrorModuleName e)), + ": definitions out of order: ", + (Core.unName (ErrorPackaging.definitionsOutOfOrderErrorPrecedingName e)), + " precedes ", + (Core.unName (ErrorPackaging.definitionsOutOfOrderErrorFollowingName e))] + +-- | Show a duplicate definition name error as a string +duplicateDefinitionNameError :: ErrorPackaging.DuplicateDefinitionNameError -> String +duplicateDefinitionNameError e = + Strings.concat [ + "in module ", + (Packaging.unModuleName (ErrorPackaging.duplicateDefinitionNameErrorModuleName e)), + ": duplicate definition name ", + (Core.unName (ErrorPackaging.duplicateDefinitionNameErrorName e))] + +-- | Show a duplicate module namespace error as a string +duplicateModuleNameError :: ErrorPackaging.DuplicateModuleNameError -> String +duplicateModuleNameError e = + Strings.concat [ + "duplicate module namespace ", + (Packaging.unModuleName (ErrorPackaging.duplicateModuleNameErrorModuleName e))] + +-- | Show an invalid definition name error as a string +invalidDefinitionNameError :: ErrorPackaging.InvalidDefinitionNameError -> String +invalidDefinitionNameError e = + Strings.concat [ + "in module ", + (Packaging.unModuleName (ErrorPackaging.invalidDefinitionNameErrorModuleName e)), + ": definition ", + (Core.unName (ErrorPackaging.invalidDefinitionNameErrorName e)), + " does not match expected ", + (PrintUtil.caseConvention (ErrorPackaging.invalidDefinitionNameErrorExpectedConvention e))] + +-- | Show an invalid module error as a string +invalidModuleError :: ErrorPackaging.InvalidModuleError -> String +invalidModuleError e = + Strings.concat2 "invalid module: " (case e of + ErrorPackaging.InvalidModuleErrorConflictingVariantName v0 -> conflictingVariantNameError v0 + ErrorPackaging.InvalidModuleErrorDefinitionNotInModuleName v0 -> definitionNotInModuleNameError v0 + ErrorPackaging.InvalidModuleErrorDefinitionsOutOfOrder v0 -> definitionsOutOfOrderError v0 + ErrorPackaging.InvalidModuleErrorDuplicateDefinitionName v0 -> duplicateDefinitionNameError v0 + ErrorPackaging.InvalidModuleErrorInvalidDefinitionName v0 -> invalidDefinitionNameError v0 + ErrorPackaging.InvalidModuleErrorInvalidModuleNameConvention v0 -> invalidModuleNameConventionError v0 + ErrorPackaging.InvalidModuleErrorMissingDocumentation v0 -> missingDocumentationError v0) + +-- | Show an invalid namespace convention error as a string +invalidModuleNameConventionError :: ErrorPackaging.InvalidModuleNameConventionError -> String +invalidModuleNameConventionError e = + Strings.concat [ + "namespace ", + (Packaging.unModuleName (ErrorPackaging.invalidModuleNameConventionErrorModuleName e)), + " does not match the dotted-camelCase naming convention"] + +-- | Show an invalid package error as a string +invalidPackageError :: ErrorPackaging.InvalidPackageError -> String +invalidPackageError e = + Strings.concat2 "invalid package: " (case e of + ErrorPackaging.InvalidPackageErrorConflictingModuleName v0 -> conflictingModuleNameError v0 + ErrorPackaging.InvalidPackageErrorDuplicateModuleName v0 -> duplicateModuleNameError v0 + ErrorPackaging.InvalidPackageErrorInvalidModule v0 -> invalidModuleError v0 + ErrorPackaging.InvalidPackageErrorInvalidPackageName v0 -> invalidPackageNameError v0 + ErrorPackaging.InvalidPackageErrorUndeclaredDependency v0 -> undeclaredDependencyError v0) + +-- | Show an invalid package name error as a string +invalidPackageNameError :: ErrorPackaging.InvalidPackageNameError -> String +invalidPackageNameError e = + Strings.concat [ + "package name ", + (Packaging.unPackageName (ErrorPackaging.invalidPackageNameErrorPackageName e)), + " does not match the hyphen-separated lowercase naming convention"] + +-- | Show a missing documentation error as a string +missingDocumentationError :: ErrorPackaging.MissingDocumentationError -> String +missingDocumentationError e = + Strings.concat [ + "in module ", + (Packaging.unModuleName (ErrorPackaging.missingDocumentationErrorModuleName e)), + ": definition ", + (Core.unName (ErrorPackaging.missingDocumentationErrorName e)), + " lacks a description annotation"] + +-- | Show an undeclared dependency error as a string +undeclaredDependencyError :: ErrorPackaging.UndeclaredDependencyError -> String +undeclaredDependencyError e = + Strings.concat [ + "module ", + (Packaging.unModuleName (ErrorPackaging.undeclaredDependencyErrorModuleName e)), + " references ", + (Core.unName (ErrorPackaging.undeclaredDependencyErrorReferencedName e)), + ", whose owning module ", + (Packaging.unModuleName (ErrorPackaging.undeclaredDependencyErrorOwningModuleName e)), + " is not among its declared dependencies; add it to moduleDependencies"] diff --git a/src/main/haskell/Hydra/Print/Errors.hs b/src/main/haskell/Hydra/Print/Errors.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Errors.hs @@ -0,0 +1,215 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.error types + +module Hydra.Print.Errors where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +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.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Error.Core as PrintErrorCore +import qualified Hydra.Print.Typing as PrintTyping +import qualified Hydra.Print.Variants as PrintVariants +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a checking error as a string +checkingError :: Checking.CheckingError -> String +checkingError ce = + case ce of + Checking.CheckingErrorIncorrectUnification v0 -> incorrectUnificationError v0 + Checking.CheckingErrorNotAForallType v0 -> notAForallTypeError v0 + Checking.CheckingErrorNotAFunctionType v0 -> notAFunctionTypeError v0 + Checking.CheckingErrorTypeArityMismatch v0 -> typeArityMismatchError v0 + Checking.CheckingErrorTypeMismatch v0 -> typeMismatchError v0 + Checking.CheckingErrorUnboundTypeVariables v0 -> unboundTypeVariablesError v0 + Checking.CheckingErrorUnequalTypes v0 -> unequalTypesError v0 + Checking.CheckingErrorUnsupportedTermVariant v0 -> unsupportedTermVariantError v0 + Checking.CheckingErrorUntypedLambda v0 -> untypedLambdaError v0 + Checking.CheckingErrorUntypedLetBinding v0 -> untypedLetBindingError v0 + +-- | Show a decoding error as a string +decodingError :: Errors.DecodingError -> String +decodingError de = Strings.concat2 "decoding error: " (Errors.unDecodingError de) + +-- | Show an error as a string +error :: Errors.Error -> String +error e = + case e of + Errors.ErrorChecking v0 -> checkingError v0 + Errors.ErrorDecoding v0 -> decodingError v0 + Errors.ErrorDuplicateBinding v0 -> PrintErrorCore.duplicateBindingError v0 + Errors.ErrorDuplicateField v0 -> PrintErrorCore.duplicateFieldError v0 + Errors.ErrorExtraction _ -> "extraction error" + Errors.ErrorInference _ -> "inference error" + Errors.ErrorOther v0 -> otherError v0 + Errors.ErrorResolution v0 -> resolutionError v0 + Errors.ErrorUndefinedField v0 -> PrintErrorCore.undefinedFieldError v0 + Errors.ErrorUndefinedTermVariable v0 -> PrintErrorCore.undefinedTermVariableError v0 + Errors.ErrorUntypedTermVariable v0 -> PrintErrorCore.untypedTermVariableError v0 + Errors.ErrorUnexpectedTermVariant v0 -> PrintErrorCore.unexpectedTermVariantError v0 + Errors.ErrorUnexpectedTypeVariant v0 -> PrintErrorCore.unexpectedTypeVariantError v0 + Errors.ErrorUnification v0 -> unificationError v0 + +-- | Show an incorrect unification error as a string +incorrectUnificationError :: Checking.IncorrectUnificationError -> String +incorrectUnificationError e = + + let subst = Checking.incorrectUnificationErrorSubstitution e + in (Strings.concat2 "incorrect unification: " (PrintTyping.typeSubst subst)) + +-- | Show a not-a-forall-type error as a string +notAForallTypeError :: Checking.NotAForallTypeError -> String +notAForallTypeError e = + + let typ = Checking.notAForallTypeErrorType e + args = Checking.notAForallTypeErrorTypeArguments e + in (Strings.concat [ + "not a forall type: ", + (PrintCore.type_ typ), + ". Trying to apply ", + (Literals.showInt32 (Lists.length args)), + " type argument(s): ", + (Formatting.showList PrintCore.type_ args)]) + +-- | Show a not-a-function-type error as a string +notAFunctionTypeError :: Checking.NotAFunctionTypeError -> String +notAFunctionTypeError e = + + let typ = Checking.notAFunctionTypeErrorType e + in (Strings.concat2 "not a function type: " (PrintCore.type_ typ)) + +-- | Show an other error as a string +otherError :: Errors.OtherError -> String +otherError oe = Errors.unOtherError oe + +-- | Show a resolution error as a string, including the offending name or shape +resolutionError :: Errors.ResolutionError -> String +resolutionError re = + case re of + Errors.ResolutionErrorNoSuchBinding v0 -> Strings.concat2 "no such binding: " (Core.unName (Errors.noSuchBindingErrorName v0)) + Errors.ResolutionErrorNoSuchPrimitive v0 -> Strings.concat2 "no such primitive: " (Core.unName (Errors.noSuchPrimitiveErrorName v0)) + Errors.ResolutionErrorNoMatchingField v0 -> Strings.concat2 "no matching field: " (Core.unName (Errors.noMatchingFieldErrorFieldName v0)) + Errors.ResolutionErrorOther v0 -> Strings.concat2 "resolution error: " (Errors.unOtherResolutionError v0) + Errors.ResolutionErrorUnexpectedShape v0 -> Strings.concat [ + "unexpected shape: expected ", + (Errors.unexpectedShapeErrorExpected v0), + " but got ", + (Errors.unexpectedShapeErrorActual v0)] + +-- | Show a type arity mismatch error as a string +typeArityMismatchError :: Checking.TypeArityMismatchError -> String +typeArityMismatchError e = + + let typ = Checking.typeArityMismatchErrorType e + expected = Checking.typeArityMismatchErrorExpectedArity e + actual = Checking.typeArityMismatchErrorActualArity e + args = Checking.typeArityMismatchErrorTypeArguments e + in (Strings.concat [ + "type ", + (PrintCore.type_ typ), + " applied to the wrong number of type arguments (expected ", + (Literals.showInt32 expected), + ", got ", + (Literals.showInt32 actual), + "): ", + (Formatting.showList PrintCore.type_ args)]) + +-- | Show a type mismatch error as a string +typeMismatchError :: Checking.TypeMismatchError -> String +typeMismatchError e = + + let expected = Checking.typeMismatchErrorExpectedType e + actual = Checking.typeMismatchErrorActualType e + in (Strings.concat [ + "type mismatch: expected ", + (PrintCore.type_ expected), + " but found ", + (PrintCore.type_ actual)]) + +-- | Show an unbound type variables error as a string +unboundTypeVariablesError :: Checking.UnboundTypeVariablesError -> String +unboundTypeVariablesError e = + + let vars = Checking.unboundTypeVariablesErrorVariables e + typ = Checking.unboundTypeVariablesErrorType e + in (Strings.concat [ + "unbound type variables: {", + (Strings.join ", " (Lists.map Core.unName (Sets.toList vars))), + "} in type ", + (PrintCore.type_ typ)]) + +-- | Show an unequal types error as a string +unequalTypesError :: Checking.UnequalTypesError -> String +unequalTypesError e = + + let types = Checking.unequalTypesErrorTypes e + desc = Checking.unequalTypesErrorDescription e + in (Strings.concat [ + "unequal types ", + (Formatting.showList PrintCore.type_ types), + " in ", + desc]) + +-- | Show a unification error as a string +unificationError :: Errors.UnificationError -> String +unificationError e = + + let lt = Errors.unificationErrorLeftType e + rt = Errors.unificationErrorRightType e + msg = Errors.unificationErrorMessage e + in (Strings.concat [ + "unification error: cannot unify ", + (PrintCore.type_ lt), + " with ", + (PrintCore.type_ rt), + ": ", + msg]) + +-- | Show an unsupported term variant error as a string +unsupportedTermVariantError :: Checking.UnsupportedTermVariantError -> String +unsupportedTermVariantError e = + Strings.concat2 "unsupported term variant: " (PrintVariants.termVariant (Checking.unsupportedTermVariantErrorTermVariant e)) + +-- | Show an untyped lambda error as a string +untypedLambdaError :: t0 -> String +untypedLambdaError _ = "untyped lambda" + +-- | Show an untyped let binding error as a string +untypedLetBindingError :: Checking.UntypedLetBindingError -> String +untypedLetBindingError e = + + let b = Checking.untypedLetBindingErrorBinding e + in (Strings.concat2 "untyped let binding: " (PrintCore.binding b)) diff --git a/src/main/haskell/Hydra/Print/Graph.hs b/src/main/haskell/Hydra/Print/Graph.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Graph.hs @@ -0,0 +1,50 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.graph types + +module Hydra.Print.Graph where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a list of bindings as a string +graph :: [Core.Binding] -> String +graph elements = + + let elementStrs = Lists.map PrintCore.binding elements + in (Strings.concat [ + "{", + (Strings.join ", " elementStrs), + "}"]) diff --git a/src/main/haskell/Hydra/Print/Paths.hs b/src/main/haskell/Hydra/Print/Paths.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Paths.hs @@ -0,0 +1,141 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Utilities for working with subterm steps and paths. + +module Hydra.Print.Paths where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +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.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M + +-- | Convert a subterm step to a string representation +subtermStep :: Paths.SubtermStep -> Maybe String +subtermStep step = + + let idx = \i -> Nothing + idxSuff = \suffix -> \i -> Optionals.map (\s -> Strings.concat2 s suffix) (idx i) + in case step of + Paths.SubtermStepAnnotatedBody -> Nothing + Paths.SubtermStepApplicationFunction -> Just "fun" + Paths.SubtermStepApplicationArgument -> Just "arg" + Paths.SubtermStepLambdaBody -> Just "body" + Paths.SubtermStepUnionCasesDefault -> Just "default" + Paths.SubtermStepUnionCasesBranch v0 -> Just (Strings.concat2 "." (Core.unName v0)) + Paths.SubtermStepLetBody -> Just "in" + Paths.SubtermStepLetBinding v0 -> Just (Strings.concat2 (Core.unName v0) "=") + Paths.SubtermStepListElement v0 -> idx v0 + Paths.SubtermStepMapKey v0 -> idxSuff ".key" v0 + Paths.SubtermStepMapValue v0 -> idxSuff ".value" v0 + Paths.SubtermStepOptionalTerm -> Just "given" + Paths.SubtermStepProductTerm v0 -> idx v0 + Paths.SubtermStepRecordField v0 -> Just (Strings.concat2 "." (Core.unName v0)) + Paths.SubtermStepSetElement v0 -> idx v0 + Paths.SubtermStepSumTerm -> Nothing + Paths.SubtermStepTypeLambdaBody -> Nothing + Paths.SubtermStepTypeApplicationTerm -> Nothing + Paths.SubtermStepInjectionTerm -> Nothing + Paths.SubtermStepWrappedTerm -> Nothing + +-- | Build a subterm graph from a term +termToSubtermGraph :: M.Map Packaging.ModuleName String -> Core.Term -> Paths.SubtermGraph +termToSubtermGraph namespaces term = + + let dontCareStep = Paths.SubtermStepAnnotatedBody + helper = + \ids -> \mroot -> \path -> \state -> \stepTerm -> + let step = Pairs.first stepTerm + currentTerm = Pairs.second stepTerm + nodesEdges = Pairs.first state + visited = Pairs.second state + nodes = Pairs.first nodesEdges + edges = Pairs.second nodesEdges + nextPath = Lists.cons step path + in case currentTerm of + Core.TermLet v0 -> + let bindings = Core.letBindings v0 + env = Core.letBody v0 + bindingNames = Lists.map Core.bindingName bindings + addBindingName = + \nodesVisitedIds -> \name -> + let currentNodesVisited = Pairs.first nodesVisitedIds + currentIds = Pairs.second nodesVisitedIds + currentNodes = Pairs.first currentNodesVisited + currentVisited = Pairs.second currentNodesVisited + rawLabel = Names.compactName namespaces name + uniqueLabel = Names.chooseUniqueLabel currentVisited rawLabel + node = + Paths.SubtermNode { + Paths.subtermNodeName = name, + Paths.subtermNodeLabel = rawLabel, + Paths.subtermNodeId = uniqueLabel} + newVisited = Sets.insert uniqueLabel currentVisited + newNodes = Lists.cons node currentNodes + newIds = Maps.insert name node currentIds + in ((newNodes, newVisited), newIds) + nodesVisitedIds1 = Lists.foldl addBindingName (([], visited), ids) bindingNames + nodes1 = Pairs.first (Pairs.first nodesVisitedIds1) + visited1 = Pairs.second (Pairs.first nodesVisitedIds1) + ids1 = Pairs.second nodesVisitedIds1 + addBindingTerm = + \currentState -> \nodeBinding -> + let root = Pairs.first nodeBinding + binding = Pairs.second nodeBinding + term1 = Core.bindingTerm binding + in (helper ids1 (Just root) [] currentState (dontCareStep, term1)) + nodeBindingPairs = Lists.zip nodes1 bindings + stateAfterBindings = Lists.foldl addBindingTerm ((Lists.concat2 nodes1 nodes, edges), visited1) nodeBindingPairs + in (helper ids1 mroot nextPath stateAfterBindings (Paths.SubtermStepLetBody, env)) + Core.TermVariable v0 -> Optionals.cases mroot state (\root -> Optionals.cases (Maps.lookup v0 ids) state (\node -> + let edge = + Paths.SubtermEdge { + Paths.subtermEdgeSource = root, + Paths.subtermEdgePath = (Paths.SubtermPath (Lists.reverse nextPath)), + Paths.subtermEdgeTarget = node} + newEdges = Lists.cons edge edges + in ((nodes, newEdges), visited))) + _ -> Lists.foldl (helper ids mroot nextPath) state (Rewriting.subtermsWithSteps currentTerm) + initialState = (([], []), Sets.empty) + result = helper Maps.empty Nothing [] initialState (dontCareStep, term) + finalNodesEdges = Pairs.first result + finalNodes = Pairs.first finalNodesEdges + finalEdges = Pairs.second finalNodesEdges + in Paths.SubtermGraph { + Paths.subtermGraphNodes = finalNodes, + Paths.subtermGraphEdges = finalEdges} diff --git a/src/main/haskell/Hydra/Print/Pcre/Regex.hs b/src/main/haskell/Hydra/Print/Pcre/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Pcre/Regex.hs @@ -0,0 +1,153 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Per-dialect printer rendering the hydra.regex AST into the PCRE / java.util.regex / ECMA family syntax (Java, Scala, Clojure, Python, Common Lisp, TypeScript). Differs from the canonical hydra.print.regex in exactly one place: Hydra's . (any character INCLUDING newline) renders as [\s\S] rather than a bare . (whose native meaning excludes newline in these engines). All other productions match the canonical form. See docs/specification/regex.md and issue #567. + +module Hydra.Print.Pcre.Regex where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Render an alternation, joining its branches with the | operator. +alternation :: [[Regex.Quantified]] -> String +alternation alt = Strings.join "|" (Lists.map regexSequence alt) + +-- | Render a single atom; the . metacharacter renders as [\s\S] to preserve newline-inclusive 'any'. +atom :: Regex.Atom -> String +atom a = + case a of + Regex.AtomLiteral v0 -> escapeLiteral v0 + Regex.AtomAny -> "[\\s\\S]" + Regex.AtomAnchorStart -> "^" + Regex.AtomAnchorEnd -> "$" + Regex.AtomGroup v0 -> Strings.concat [ + "(", + (alternation v0), + ")"] + Regex.AtomClass v0 -> characterClass v0 + +-- | Render a character class, including the leading ^ for a negated class. +characterClass :: Regex.CharacterClass -> String +characterClass cc = + Strings.concat [ + "[", + (Logic.ifElse (Regex.characterClassNegated cc) "^" ""), + (Strings.concat (Lists.map classItem (Regex.characterClassItems cc))), + "]"] + +-- | Render one character-class member (a single character or an inclusive range). +classItem :: Regex.ClassItem -> String +classItem item = + case item of + Regex.ClassItemCharacter v0 -> escapeClassChar v0 + Regex.ClassItemRange v0 -> Strings.concat [ + escapeClassChar (Regex.characterRangeFrom v0), + "-", + (escapeClassChar (Regex.characterRangeTo v0))] + +-- | Render a code point inside a character class, uniformly escaping the class metacharacters \ ] ^ -. +escapeClassChar :: Int -> String +escapeClassChar c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 92, + 93, + 94, + 45] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a literal code point in top-level context, backslash-escaping PCRE/ECMA metacharacters. +escapeLiteral :: Int -> String +escapeLiteral c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 46, + 94, + 36, + 42, + 43, + 63, + 40, + 41, + 91, + 93, + 123, + 125, + 124, + 92] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a hydra.regex AST into PCRE / java.util.regex / ECMA syntax. Identical to the canonical printer except that . (any incl. newline) becomes [\s\S]. +printRegex :: [[Regex.Quantified]] -> String +printRegex r = alternation r + +-- | Render an atom followed by its quantifier suffix. +quantified :: Regex.Quantified -> String +quantified qa = Strings.concat2 (atom (Regex.quantifiedAtom qa)) (quantifier (Regex.quantifiedQuantifier qa)) + +-- | Render a quantifier suffix; the 'one' quantifier renders as the empty string. +quantifier :: Regex.Quantifier -> String +quantifier q = + case q of + Regex.QuantifierOne -> "" + Regex.QuantifierZeroOrOne -> "?" + Regex.QuantifierZeroOrMore -> "*" + Regex.QuantifierOneOrMore -> "+" + Regex.QuantifierExactly v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + "}"] + Regex.QuantifierAtLeast v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + ",}"] + Regex.QuantifierRange_ v0 -> Strings.concat [ + "{", + (Literals.showInt32 (Regex.quantifierRangeMin v0)), + ",", + (Literals.showInt32 (Regex.quantifierRangeMax v0)), + "}"] + +-- | Render a sequence of quantified atoms by concatenation. +regexSequence :: [Regex.Quantified] -> String +regexSequence s = Strings.concat (Lists.map quantified s) + +-- | Render a single Unicode code point as a one-character string. +showCodePoint :: Int -> String +showCodePoint c = Strings.fromList [ + c] diff --git a/src/main/haskell/Hydra/Print/Posix/Regex.hs b/src/main/haskell/Hydra/Print/Posix/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Posix/Regex.hs @@ -0,0 +1,163 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Per-dialect printer rendering the hydra.regex AST into POSIX ERE syntax (Haskell Text.Regex.TDFA, Scheme Guile (ice-9 regex)). Differs from the canonical hydra.print.regex in one place: Hydra's . (any character INCLUDING newline) renders as the explicit full-code-point-range class [-], because POSIX ERE's native . excludes newline and POSIX ERE does not support the \s / \S shorthands (confirmed by TDFA probe). All other productions are native POSIX ERE. See docs/specification/regex.md and issue #567. + +module Hydra.Print.Posix.Regex where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Render an alternation, joining its branches with the | operator. +alternation :: [[Regex.Quantified]] -> String +alternation alt = Strings.join "|" (Lists.map regexSequence alt) + +-- | The POSIX ERE rendering of Hydra's . (any character incl. newline): an explicit character-class range spanning the whole Unicode scalar range, which POSIX ERE engines match literally. +anyClass :: String +anyClass = + Strings.concat [ + "[", + (showCodePoint 0), + "-", + (showCodePoint 1114111), + "]"] + +-- | Render a single atom; . renders as the explicit full-code-point-range class (POSIX-safe). +atom :: Regex.Atom -> String +atom a = + case a of + Regex.AtomLiteral v0 -> escapeLiteral v0 + Regex.AtomAny -> anyClass + Regex.AtomAnchorStart -> "^" + Regex.AtomAnchorEnd -> "$" + Regex.AtomGroup v0 -> Strings.concat [ + "(", + (alternation v0), + ")"] + Regex.AtomClass v0 -> characterClass v0 + +-- | Render a character class, including the leading ^ for a negated class. +characterClass :: Regex.CharacterClass -> String +characterClass cc = + Strings.concat [ + "[", + (Logic.ifElse (Regex.characterClassNegated cc) "^" ""), + (Strings.concat (Lists.map classItem (Regex.characterClassItems cc))), + "]"] + +-- | Render one character-class member (a single character or an inclusive range). +classItem :: Regex.ClassItem -> String +classItem item = + case item of + Regex.ClassItemCharacter v0 -> escapeClassChar v0 + Regex.ClassItemRange v0 -> Strings.concat [ + escapeClassChar (Regex.characterRangeFrom v0), + "-", + (escapeClassChar (Regex.characterRangeTo v0))] + +-- | Render a code point inside a character class, uniformly escaping the class metacharacters \ ] ^ -. +escapeClassChar :: Int -> String +escapeClassChar c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 92, + 93, + 94, + 45] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a literal code point in top-level context, backslash-escaping POSIX ERE metacharacters. +escapeLiteral :: Int -> String +escapeLiteral c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 46, + 94, + 36, + 42, + 43, + 63, + 40, + 41, + 91, + 93, + 123, + 125, + 124, + 92] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a hydra.regex AST into POSIX ERE syntax. Identical to the canonical printer except that . (any incl. newline) becomes the explicit full-code-point-range class. +printRegex :: [[Regex.Quantified]] -> String +printRegex r = alternation r + +-- | Render an atom followed by its quantifier suffix. +quantified :: Regex.Quantified -> String +quantified qa = Strings.concat2 (atom (Regex.quantifiedAtom qa)) (quantifier (Regex.quantifiedQuantifier qa)) + +-- | Render a quantifier suffix; the 'one' quantifier renders as the empty string. +quantifier :: Regex.Quantifier -> String +quantifier q = + case q of + Regex.QuantifierOne -> "" + Regex.QuantifierZeroOrOne -> "?" + Regex.QuantifierZeroOrMore -> "*" + Regex.QuantifierOneOrMore -> "+" + Regex.QuantifierExactly v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + "}"] + Regex.QuantifierAtLeast v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + ",}"] + Regex.QuantifierRange_ v0 -> Strings.concat [ + "{", + (Literals.showInt32 (Regex.quantifierRangeMin v0)), + ",", + (Literals.showInt32 (Regex.quantifierRangeMax v0)), + "}"] + +-- | Render a sequence of quantified atoms by concatenation. +regexSequence :: [Regex.Quantified] -> String +regexSequence s = Strings.concat (Lists.map quantified s) + +-- | Render a single Unicode code point as a one-character string. +showCodePoint :: Int -> String +showCodePoint c = Strings.fromList [ + c] diff --git a/src/main/haskell/Hydra/Print/Regex.hs b/src/main/haskell/Hydra/Print/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Regex.hs @@ -0,0 +1,153 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Canonical printer for Hydra's translingual regular-expression syntax (docs/specification/regex.md): hydra.regex AST -> canonical text. Escapes minimally (a character is escaped only where it is special in its context), so that print.regex . parse.regex is idempotent on well-formed input. Per-dialect renderers (hydra.print..regex) build on this. See issue #567. + +module Hydra.Print.Regex where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Render an alternation, joining its branches with the | operator. +alternation :: [[Regex.Quantified]] -> String +alternation alt = Strings.join "|" (Lists.map regexSequence alt) + +-- | Render a single atom (literal, ., anchor, group, or class) to canonical text. +atom :: Regex.Atom -> String +atom a = + case a of + Regex.AtomLiteral v0 -> escapeLiteral v0 + Regex.AtomAny -> "." + Regex.AtomAnchorStart -> "^" + Regex.AtomAnchorEnd -> "$" + Regex.AtomGroup v0 -> Strings.concat [ + "(", + (alternation v0), + ")"] + Regex.AtomClass v0 -> characterClass v0 + +-- | Render a character class, including the leading ^ for a negated class. +characterClass :: Regex.CharacterClass -> String +characterClass cc = + Strings.concat [ + "[", + (Logic.ifElse (Regex.characterClassNegated cc) "^" ""), + (Strings.concat (Lists.map classItem (Regex.characterClassItems cc))), + "]"] + +-- | Render one character-class member (a single character or an inclusive range) to canonical text. +classItem :: Regex.ClassItem -> String +classItem item = + case item of + Regex.ClassItemCharacter v0 -> escapeClassChar v0 + Regex.ClassItemRange v0 -> Strings.concat [ + escapeClassChar (Regex.characterRangeFrom v0), + "-", + (escapeClassChar (Regex.characterRangeTo v0))] + +-- | Render a code point inside a character class, backslash-escaping it iff it is one of the class metacharacters \ ] ^ -. Escaping is uniform, with no positional exceptions (a literal '-' always prints as \-). +escapeClassChar :: Int -> String +escapeClassChar c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 92, + 93, + 94, + 45] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a literal code point in top-level context, backslash-escaping it iff it is one of the top-level metacharacters . ^ $ * + ? ( ) [ ] { } | \. A '-' is not special at top level and prints bare. +escapeLiteral :: Int -> String +escapeLiteral c = + + let isMeta = + Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [ + 46, + 94, + 36, + 42, + 43, + 63, + 40, + 41, + 91, + 93, + 123, + 125, + 124, + 92] + in (Logic.ifElse isMeta (Strings.concat2 "\\" (showCodePoint c)) (showCodePoint c)) + +-- | Render a hydra.regex AST to canonical Hydra regex text. Escapes minimally, so that printRegex . parseRegex is the identity on well-formed patterns. +printRegex :: [[Regex.Quantified]] -> String +printRegex r = alternation r + +-- | Render an atom followed by its quantifier suffix. +quantified :: Regex.Quantified -> String +quantified qa = Strings.concat2 (atom (Regex.quantifiedAtom qa)) (quantifier (Regex.quantifiedQuantifier qa)) + +-- | Render a quantifier suffix; the 'one' quantifier renders as the empty string. +quantifier :: Regex.Quantifier -> String +quantifier q = + case q of + Regex.QuantifierOne -> "" + Regex.QuantifierZeroOrOne -> "?" + Regex.QuantifierZeroOrMore -> "*" + Regex.QuantifierOneOrMore -> "+" + Regex.QuantifierExactly v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + "}"] + Regex.QuantifierAtLeast v0 -> Strings.concat [ + "{", + (Literals.showInt32 v0), + ",}"] + Regex.QuantifierRange_ v0 -> Strings.concat [ + "{", + (Literals.showInt32 (Regex.quantifierRangeMin v0)), + ",", + (Literals.showInt32 (Regex.quantifierRangeMax v0)), + "}"] + +-- | Render a sequence of quantified atoms by concatenation. +regexSequence :: [Regex.Quantified] -> String +regexSequence s = Strings.concat (Lists.map quantified s) + +-- | Render a single Unicode code point as a one-character string. +showCodePoint :: Int -> String +showCodePoint c = Strings.fromList [ + c] diff --git a/src/main/haskell/Hydra/Print/Typing.hs b/src/main/haskell/Hydra/Print/Typing.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Typing.hs @@ -0,0 +1,73 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.typing types + +module Hydra.Print.Typing where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a type constraint as a string +typeConstraint :: Typing.TypeConstraint -> String +typeConstraint tc = + + let ltyp = Typing.typeConstraintLeft tc + rtyp = Typing.typeConstraintRight tc + in (Strings.concat [ + PrintCore.type_ ltyp, + "\8801", + (PrintCore.type_ rtyp)]) + +-- | Show a type substitution as a string +typeSubst :: Typing.TypeSubst -> String +typeSubst ts = + + let subst = Typing.unTypeSubst ts + pairs = Maps.toList subst + showPair = + \pair -> + let name = Core.unName (Pairs.first pair) + typ = Pairs.second pair + in (Strings.concat [ + name, + "\8614", + (PrintCore.type_ typ)]) + pairStrs = Lists.map showPair pairs + in (Strings.concat [ + "{", + (Strings.join "," pairStrs), + "}"]) diff --git a/src/main/haskell/Hydra/Print/Util.hs b/src/main/haskell/Hydra/Print/Util.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Util.hs @@ -0,0 +1,54 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.util types + +module Hydra.Print.Util where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a case convention as a string +caseConvention :: Util.CaseConvention -> String +caseConvention c = + case c of + Util.CaseConventionLowerSnake -> "lower_snake_case" + Util.CaseConventionUpperSnake -> "UPPER_SNAKE_CASE" + Util.CaseConventionCamel -> "camelCase" + Util.CaseConventionPascal -> "PascalCase" + +-- | Show a comparison result as a string +comparison :: Util.Comparison -> String +comparison c = + case c of + Util.ComparisonLessThan -> "lessThan" + Util.ComparisonEqualTo -> "equalTo" + Util.ComparisonGreaterThan -> "greaterThan" diff --git a/src/main/haskell/Hydra/Print/Variants.hs b/src/main/haskell/Hydra/Print/Variants.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Print/Variants.hs @@ -0,0 +1,86 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | String representations of hydra.variants types + +module Hydra.Print.Variants where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Show a term variant as a string +termVariant :: Variants.TermVariant -> String +termVariant x = + case x of + Variants.TermVariantAnnotated -> "annotated" + Variants.TermVariantApplication -> "application" + Variants.TermVariantCases -> "cases" + Variants.TermVariantEither -> "either" + Variants.TermVariantLambda -> "lambda" + Variants.TermVariantLet -> "let" + Variants.TermVariantList -> "list" + Variants.TermVariantLiteral -> "literal" + Variants.TermVariantMap -> "map" + Variants.TermVariantOptional -> "optional" + Variants.TermVariantPair -> "pair" + Variants.TermVariantProject -> "project" + Variants.TermVariantRecord -> "record" + Variants.TermVariantSet -> "set" + Variants.TermVariantTypeLambda -> "typeLambda" + Variants.TermVariantTypeApplication -> "typeApplication" + Variants.TermVariantInject -> "inject" + Variants.TermVariantUnit -> "unit" + Variants.TermVariantUnwrap -> "unwrap" + Variants.TermVariantVariable -> "variable" + Variants.TermVariantWrap -> "wrap" + +-- | Show a type variant as a string +typeVariant :: Variants.TypeVariant -> String +typeVariant x = + case x of + Variants.TypeVariantAnnotated -> "annotated" + Variants.TypeVariantApplication -> "application" + Variants.TypeVariantEffect -> "effect" + Variants.TypeVariantEither -> "either" + Variants.TypeVariantForall -> "forall" + Variants.TypeVariantFunction -> "function" + Variants.TypeVariantList -> "list" + Variants.TypeVariantLiteral -> "literal" + Variants.TypeVariantMap -> "map" + Variants.TypeVariantOptional -> "optional" + Variants.TypeVariantPair -> "pair" + Variants.TypeVariantRecord -> "record" + Variants.TypeVariantSet -> "set" + Variants.TypeVariantUnion -> "union" + Variants.TypeVariantUnit -> "unit" + Variants.TypeVariantVariable -> "variable" + Variants.TypeVariantVoid -> "void" + Variants.TypeVariantWrap -> "wrap" diff --git a/src/main/haskell/Hydra/Read/Docs.hs b/src/main/haskell/Hydra/Read/Docs.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Read/Docs.hs +++ /dev/null @@ -1,69 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | Parser for Hydra documentation strings, producing DocSegment lists - -module Hydra.Read.Docs where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic -import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Parse the content between the doc-escape delimiters into an EntityReference. The input is the inner content (tag and optional rhs), e.g. "type hydra.core.Lambda". Returns nothing for unrecognized tags. -parseDocAnnotation :: String -> Maybe Packaging.EntityReference -parseDocAnnotation inner = - - let parts = Strings.splitOn " " inner - tag = Optionals.fromOptional "" (Lists.maybeHead parts) - rhs = Strings.intercalate " " (Lists.drop 1 parts) - in (Logic.ifElse (Equality.equal tag "primitive") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferencePrimitive (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "term") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferenceTerm (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "type") (Just (Packaging.EntityReferenceDefinition (Packaging.DefinitionReferenceType (Core.Name rhs)))) (Logic.ifElse (Equality.equal tag "module") (Just (Packaging.EntityReferenceModule (Packaging.ModuleName rhs))) (Logic.ifElse (Equality.equal tag "package") (Just (Packaging.EntityReferencePackage (Packaging.PackageName rhs))) (Logic.ifElse (Equality.equal tag "term-expr") (Just (Packaging.EntityReferenceTermExpr rhs)) (Logic.ifElse (Equality.equal tag "type-expr") (Just (Packaging.EntityReferenceTypeExpr rhs)) Nothing))))))) - --- | Parse a documentation string into a list of 'DocSegment's. Recognized doc-escape tags become DocSegment.ref segments (wrapping a 'EntityReference'); all other text (including unrecognized doc-escape blocks) becomes DocSegment.text segments. Adjacent text fragments are not merged. -parseDocString :: String -> [Docs.DocSegment] -parseDocString s = - - let parts = Strings.splitOn "{@" s - head_ = Optionals.fromOptional "" (Lists.maybeHead parts) - tail_ = Lists.drop 1 parts - toSeg = - \part -> - let subparts = Strings.splitOn "}" part - inner = Optionals.fromOptional "" (Lists.maybeHead subparts) - after = Strings.intercalate "}" (Lists.drop 1 subparts) - mref = parseDocAnnotation inner - in (Optionals.cases mref [ - Docs.DocSegmentText (Strings.cat2 "{@" part)] (\ref -> Optionals.cat [ - Just (Docs.DocSegmentRef ref), - (Logic.ifElse (Equality.equal after "") Nothing (Just (Docs.DocSegmentText after)))])) - in (Lists.cons (Docs.DocSegmentText head_) (Lists.concat (Lists.map toSeg tail_))) diff --git a/src/main/haskell/Hydra/Reduction.hs b/src/main/haskell/Hydra/Reduction.hs --- a/src/main/haskell/Hydra/Reduction.hs +++ b/src/main/haskell/Hydra/Reduction.hs @@ -33,19 +33,21 @@ import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Resolution as Resolution import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -142,14 +144,14 @@ Core.TermVariable v0 -> Optionals.cases (Optionals.map Scoping.typeSchemeToFType (Maps.lookup v0 (Graph.graphBoundTypes tx))) (Optionals.cases (Maps.lookup v0 primTypes) 0 Arity.typeSchemeArity) Arity.typeArity _ -> 0 domainTypes = - \n -> \mt -> Logic.ifElse (Equality.lte n 0) [] (Optionals.cases mt (Lists.map (\_ -> Nothing) (Math.range 1 n)) (\typ -> case typ of + \n -> \mt -> Logic.ifElse (Ordering.lte n 0) [] (Optionals.cases mt (Lists.map (\_ -> Nothing) (Math.range 1 n)) (\typ -> case typ of Core.TypeFunction v0 -> Lists.cons (Just (Core.functionTypeDomain v0)) (domainTypes (Math.sub n 1) (Just (Core.functionTypeCodomain v0))) Core.TypeAnnotated v0 -> domainTypes n (Just (Core.annotatedTypeBody v0)) Core.TypeApplication v0 -> domainTypes n (Just (Core.applicationTypeFunction v0)) Core.TypeForall _ -> Lists.map (\_2 -> Nothing) (Math.range 1 n) _ -> Lists.map (\_ -> Nothing) (Math.range 1 n))) peelFunctionDomains = - \mtyp -> \n -> Logic.ifElse (Equality.lte n 0) mtyp (Optionals.cases mtyp Nothing (\typ -> case typ of + \mtyp -> \n -> Logic.ifElse (Ordering.lte n 0) mtyp (Optionals.cases mtyp Nothing (\typ -> case typ of Core.TypeFunction v0 -> peelFunctionDomains (Just (Core.functionTypeCodomain v0)) (Math.sub n 1) Core.TypeAnnotated v0 -> peelFunctionDomains (Just (Core.annotatedTypeBody v0)) n Core.TypeApplication v0 -> peelFunctionDomains (Just (Core.applicationTypeFunction v0)) n @@ -163,14 +165,14 @@ Core.applicationArgument = arg})) head args numArgs = Lists.length args needed = Math.sub arity numArgs - in (Logic.ifElse (Logic.and (Equality.gt needed 0) (Logic.or alwaysPad (Equality.gt numArgs 0))) ( + in (Logic.ifElse (Logic.and (Ordering.gt needed 0) (Logic.or alwaysPad (Ordering.gt numArgs 0))) ( let indices = Math.range 1 needed remainingType = peelFunctionDomains headTyp numArgs domains = domainTypes needed remainingType codomainType = peelFunctionDomains remainingType needed fullyAppliedRaw = Lists.foldl (\body -> \i -> - let vn = Core.Name (Strings.cat2 "v" (Literals.showInt32 i)) + let vn = Core.Name (Strings.concat2 "v" (Literals.showInt32 i)) in (Core.TermApplication (Core.Application { Core.applicationFunction = body, Core.applicationArgument = (Core.TermVariable vn)}))) applied indices @@ -182,7 +184,7 @@ in (Lists.foldl (\body -> \idPair -> let i = Pairs.first idPair dom = Pairs.second idPair - vn = Core.Name (Strings.cat2 "v" (Literals.showInt32 i)) + vn = Core.Name (Strings.concat2 "v" (Literals.showInt32 i)) in (Core.TermLambda (Core.Lambda { Core.lambdaParameter = vn, Core.lambdaDomain = dom, @@ -371,7 +373,7 @@ in (arityOf txt (Core.typeLambdaBody v0)) Core.TermVariable v0 -> Optionals.cases (Optionals.map Scoping.typeSchemeToFType (Maps.lookup v0 (Graph.graphBoundTypes tx2))) (Eithers.map (\_tc -> Arity.typeArity (Pairs.first _tc)) (Checking.typeOf cx tx2 [] (Core.TermVariable v0))) (\t -> Right (Arity.typeArity t)) _ -> dflt - extraVariables = \n -> Lists.map (\i -> Core.Name (Strings.cat2 "v" (Literals.showInt32 i))) (Math.range 1 n) + extraVariables = \n -> Lists.map (\i -> Core.Name (Strings.concat2 "v" (Literals.showInt32 i))) (Math.range 1 n) pad = \vars -> \body -> Optionals.cases (Lists.uncons vars) body (\uc -> let v0 = Pairs.first uc @@ -420,7 +422,7 @@ Core.TermApplication (Core.Application { Core.applicationFunction = lhs2, Core.applicationArgument = rhs2}) - in (Right (Logic.ifElse (Equality.gt lhsarity 1) (padn (Math.sub lhsarity 1) a2) a2)))))) + in (Right (Logic.ifElse (Ordering.gt lhsarity 1) (padn (Math.sub lhsarity 1) a2) a2)))))) Core.TermCases v0 -> forCases v0 Core.TermProject v0 -> Right (forNullaryElim (Core.TermProject v0)) Core.TermUnwrap v0 -> Right (forNullaryElim (Core.TermUnwrap v0)) @@ -505,7 +507,7 @@ \fun -> \args -> Optionals.cases (Lists.uncons args) fun (\uc -> applyToArguments (Core.TermApplication (Core.Application { Core.applicationFunction = fun, Core.applicationArgument = (Pairs.first uc)})) (Pairs.second uc)) - mapErrorToString = \e -> Errors.ErrorOther (Errors.OtherError (ShowErrors.error e)) + mapErrorToString = \e -> Errors.ErrorOther (Errors.OtherError (PrintErrors.error e)) applyProjection = \proj -> \reducedArg -> Eithers.bind (ExtractCore.record (Core.projectionTypeName proj) graph (Strip.deannotateTerm reducedArg)) (\fields -> let matching = Lists.find (\f -> Equality.equal (Core.fieldName f) (Core.projectionFieldName proj)) fields @@ -564,7 +566,7 @@ let mPrim = Lexical.lookupPrimitive graph v0 in (Optionals.cases mPrim (Right (applyToArguments original args)) (\prim -> let arity = Arity.primitiveArity prim - in (Logic.ifElse (Equality.gt arity (Lists.length args)) (Right (applyToArguments original args)) (forPrimitive prim arity args))))) (\binding -> applyIfNullary eager2 (Core.bindingTerm binding) args)) + in (Logic.ifElse (Ordering.gt arity (Lists.length args)) (Right (applyToArguments original args)) (forPrimitive prim arity args))))) (\binding -> applyIfNullary eager2 (Core.bindingTerm binding) args)) Core.TermLet v0 -> let bindings = Core.letBindings v0 body = Core.letBody v0 diff --git a/src/main/haskell/Hydra/Reflect.hs b/src/main/haskell/Hydra/Reflect.hs --- a/src/main/haskell/Hydra/Reflect.hs +++ b/src/main/haskell/Hydra/Reflect.hs @@ -22,6 +22,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular diff --git a/src/main/haskell/Hydra/Refs.hs b/src/main/haskell/Hydra/Refs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Refs.hs @@ -0,0 +1,86 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Typed references to derived encode/decode/show functions, and structural coder builders + +module Hydra.Refs where + +import qualified Hydra.Ast as Ast +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Error.Checking as Checking +import qualified Hydra.Error.Core as ErrorCore +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.Error.Packaging as ErrorPackaging +import qualified Hydra.Error.System as ErrorSystem +import qualified Hydra.Errors as Errors +import qualified Hydra.File as File +import qualified Hydra.Graph as Graph +import qualified Hydra.Json.Model as Model +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets +import qualified Hydra.Names as Names +import qualified Hydra.Packaging as Packaging +import qualified Hydra.Parsing as Parsing +import qualified Hydra.Paths as Paths +import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex +import qualified Hydra.Relational as Relational +import qualified Hydra.System as System +import qualified Hydra.Tabular as Tabular +import qualified Hydra.Testing as Testing +import qualified Hydra.Time as Time +import qualified Hydra.Topology as Topology +import qualified Hydra.Typed as Typed +import qualified Hydra.Typing as Typing +import qualified Hydra.Util as Util +import qualified Hydra.Validation as Validation +import qualified Hydra.Variants as Variants +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S + +-- | Look up the decoder function for a type given its TypedName token +decodeRef :: Typed.TypedName t0 -> Core.Term +decodeRef tn = + Core.TermVariable (Names.derivedBindingName [ + "hydra", + "decode"] True (Typed.unTypedName tn)) + +-- | Build an encoder for a list, given an encoder for its element type +encodeList :: (t0 -> Core.Term) -> [t0] -> Core.Term +encodeList elemEncoder xs = Core.TermList (Lists.map elemEncoder xs) + +-- | Build an encoder for a map, given encoders for its key and value types +encodeMap :: Ord t0 => ((t0 -> Core.Term) -> (t1 -> Core.Term) -> M.Map t0 t1 -> Core.Term) +encodeMap keyEncoder valEncoder m = Core.TermMap (Maps.bimap keyEncoder valEncoder m) + +-- | Build an encoder for an optional value, given an encoder for its element type +encodeOptional :: (t0 -> Core.Term) -> Maybe t0 -> Core.Term +encodeOptional elemEncoder x = Core.TermOptional (Optionals.map elemEncoder x) + +-- | Build an encoder for a pair, given encoders for its first and second components +encodePair :: (t0 -> Core.Term) -> (t1 -> Core.Term) -> (t0, t1) -> Core.Term +encodePair firstEncoder secondEncoder p = Core.TermPair (Pairs.bimap firstEncoder secondEncoder p) + +-- | Look up the encoder function for a type given its TypedName token +encodeRef :: Typed.TypedName t0 -> Core.Term +encodeRef tn = + Core.TermVariable (Names.derivedBindingName [ + "hydra", + "encode"] True (Typed.unTypedName tn)) + +-- | Build an encoder for a set, given an encoder for its element type +encodeSet :: Ord t0 => ((t0 -> Core.Term) -> S.Set t0 -> Core.Term) +encodeSet elemEncoder xs = Core.TermSet (Sets.map elemEncoder xs) + +-- | Look up the string-shower function for a type given its TypedName token +showRef :: Typed.TypedName t0 -> Core.Term +showRef tn = + Core.TermVariable (Names.derivedBindingName [ + "hydra", + "show"] True (Typed.unTypedName tn)) diff --git a/src/main/haskell/Hydra/Regex.hs b/src/main/haskell/Hydra/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Regex.hs @@ -0,0 +1,162 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A model for Hydra's translingual regular-expression syntax: the abstract syntax tree (AST) into which hydra.parse.regex parses a pattern and from which hydra.print.regex (and the per-dialect hydra.print..regex renderers) emit target syntax. Covers the minimal core defined in docs/specification/regex.md (literals, character classes, ., quantifiers, alternation, anchors, grouping). See issue #567. + +module Hydra.Regex where + +import qualified Hydra.Core as Core +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | A non-empty list of alternative sequences, joined by the | operator. Matches if any alternative matches. +type Alternation = [RegexSequence] + +_Alternation = Core.Name "hydra.regex.Alternation" + +-- | A single, unquantified regex element: the smallest unit to which a quantifier may apply. +data Atom = + -- | A literal character, matched exactly. The character is a Unicode scalar value in the range [U+0000, U+10FFFF] (surrogates excluded), held as an int32 code point (the range fits in signed 32-bit, and int32 matches Hydra's string/parser code-point representation). In concrete syntax, a metacharacter is written escaped (e.g. \.); escaping is purely a concrete-syntax concern, so the AST holds the bare code point. + AtomLiteral Int | + -- | The . metacharacter; matches any single character, INCLUDING newline (unlike most host engines, whose native . excludes newline). To exclude newline, write [^\n] explicitly. + AtomAny | + -- | The ^ anchor; matches the empty string at the start of input. + AtomAnchorStart | + -- | The $ anchor; matches the empty string at the end of input. + AtomAnchorEnd | + -- | A parenthesized sub-expression, ( ... ); groups an alternation for quantification. + AtomGroup Alternation | + -- | A character class, [ ... ]; matches any single character in (or, if negated, not in) the set. + AtomClass CharacterClass + deriving (Eq, Ord, Read, Show) + +_Atom = Core.Name "hydra.regex.Atom" + +_Atom_literal = Core.Name "literal" + +_Atom_any = Core.Name "any" + +_Atom_anchorStart = Core.Name "anchorStart" + +_Atom_anchorEnd = Core.Name "anchorEnd" + +_Atom_group = Core.Name "group" + +_Atom_class = Core.Name "class" + +-- | A bracketed character class, [ ... ] or [^ ... ]. +data CharacterClass = + CharacterClass { + -- | True for a negated class ([^ ... ]), which matches any character NOT listed. + characterClassNegated :: Bool, + -- | The class members: individual characters and/or character ranges. Must be non-empty; the empty class [] and negated-empty class [^] are excluded from the core (they are not in the POSIX/PCRE/ECMA intersection). hydra.parse.regex rejects an empty class. + characterClassItems :: [ClassItem]} + deriving (Eq, Ord, Read, Show) + +_CharacterClass = Core.Name "hydra.regex.CharacterClass" + +_CharacterClass_negated = Core.Name "negated" + +_CharacterClass_items = Core.Name "items" + +-- | An inclusive range of characters within a character class, e.g. a-z. +data CharacterRange = + CharacterRange { + -- | The first character of the range (inclusive), as an int32 Unicode scalar value. + characterRangeFrom :: Int, + -- | The last character of the range (inclusive), as an int32 Unicode scalar value. + characterRangeTo :: Int} + deriving (Eq, Ord, Read, Show) + +_CharacterRange = Core.Name "hydra.regex.CharacterRange" + +_CharacterRange_from = Core.Name "from" + +_CharacterRange_to = Core.Name "to" + +-- | A member of a character class: either a single character or an inclusive character range. +data ClassItem = + -- | A single character (int32 Unicode scalar value) in the class. + ClassItemCharacter Int | + -- | An inclusive range of characters, e.g. a-z. + ClassItemRange CharacterRange + deriving (Eq, Ord, Read, Show) + +_ClassItem = Core.Name "hydra.regex.ClassItem" + +_ClassItem_character = Core.Name "character" + +_ClassItem_range = Core.Name "range" + +-- | An atom together with an optional quantifier applied to it. +data Quantified = + Quantified { + -- | The atom being quantified. + quantifiedAtom :: Atom, + -- | The quantifier; use 'one' for an unquantified atom. + quantifiedQuantifier :: Quantifier} + deriving (Eq, Ord, Read, Show) + +_Quantified = Core.Name "hydra.regex.Quantified" + +_Quantified_atom = Core.Name "atom" + +_Quantified_quantifier = Core.Name "quantifier" + +-- | A regular-expression quantifier. Mirrors hydra.query.RegexQuantifier, which models the same set of quantifiers for graph-path queries; a future refactor may hoist a shared type (see #567 findings). +data Quantifier = + -- | No quantifier; matches exactly one occurrence. + QuantifierOne | + -- | The ? quantifier; matches zero or one occurrence. + QuantifierZeroOrOne | + -- | The * quantifier; matches zero or more occurrences. + QuantifierZeroOrMore | + -- | The + quantifier; matches one or more occurrences. + QuantifierOneOrMore | + -- | The {n} quantifier; matches exactly n occurrences. + QuantifierExactly Int | + -- | The {n,} quantifier; matches at least n occurrences. + QuantifierAtLeast Int | + -- | The {n,m} quantifier; matches between n and m (inclusive) occurrences. + QuantifierRange_ QuantifierRange + deriving (Eq, Ord, Read, Show) + +_Quantifier = Core.Name "hydra.regex.Quantifier" + +_Quantifier_one = Core.Name "one" + +_Quantifier_zeroOrOne = Core.Name "zeroOrOne" + +_Quantifier_zeroOrMore = Core.Name "zeroOrMore" + +_Quantifier_oneOrMore = Core.Name "oneOrMore" + +_Quantifier_exactly = Core.Name "exactly" + +_Quantifier_atLeast = Core.Name "atLeast" + +_Quantifier_range = Core.Name "range" + +-- | The bounds of a {n,m} quantifier: between min and max (inclusive) occurrences. +data QuantifierRange = + QuantifierRange { + -- | The minimum number of occurrences (inclusive). + quantifierRangeMin :: Int, + -- | The maximum number of occurrences (inclusive). + quantifierRangeMax :: Int} + deriving (Eq, Ord, Read, Show) + +_QuantifierRange = Core.Name "hydra.regex.QuantifierRange" + +_QuantifierRange_min = Core.Name "min" + +_QuantifierRange_max = Core.Name "max" + +-- | A complete Hydra regular expression: the root of the AST. A regex is an alternation of sequences. +type Regex = Alternation + +_Regex = Core.Name "hydra.regex.Regex" + +-- | A (possibly empty) sequence of quantified atoms, matched in order. An empty sequence matches the empty string. (Named RegexSequence rather than Sequence to avoid the generated coder binding colliding with the host's built-in sequence.) +type RegexSequence = [Quantified] + +_RegexSequence = Core.Name "hydra.regex.RegexSequence" diff --git a/src/main/haskell/Hydra/Resolution.hs b/src/main/haskell/Hydra/Resolution.hs --- a/src/main/haskell/Hydra/Resolution.hs +++ b/src/main/haskell/Hydra/Resolution.hs @@ -33,10 +33,11 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping -import qualified Hydra.Show.Core as ShowCore import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System @@ -99,7 +100,7 @@ Errors.unexpectedShapeErrorActual = (Errors.unDecodingError _e)}))) (\_a -> _a) (DecodeCore.type_ graph (Core.bindingTerm el))) (\decodedType -> fieldTypes cx graph decodedType))) (\ts -> fieldTypes cx graph (Core.typeSchemeBody ts)) _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record or union type", - Errors.unexpectedShapeErrorActual = (ShowCore.type_ t)}))) + Errors.unexpectedShapeErrorActual = (PrintCore.type_ t)}))) -- | Find a field type by name in a list of field types findFieldType :: t0 -> Core.Name -> [Core.FieldType] -> Either Errors.Error Core.Type @@ -109,7 +110,7 @@ noMatch = Left (Errors.ErrorResolution (Errors.ResolutionErrorNoMatchingField (Errors.NoMatchingFieldError { Errors.noMatchingFieldErrorFieldName = fname}))) - in (Logic.ifElse (Lists.null matchingFields) noMatch (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Optionals.cases (Lists.maybeHead matchingFields) noMatch (\ft -> Right (Core.fieldTypeType ft))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorMultipleFields (Errors.MultipleFieldsError { + in (Logic.ifElse (Lists.null matchingFields) noMatch (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Optionals.cases (Lists.head matchingFields) noMatch (\ft -> Right (Core.fieldTypeType ft))) (Left (Errors.ErrorExtraction (Errors.ExtractionErrorMultipleFields (Errors.MultipleFieldsError { Errors.multipleFieldsErrorFieldName = fname})))))) -- | Fully strip a type of forall quantifiers, normalizing bound variable names for alpha-equivalence comparison @@ -120,7 +121,7 @@ \depth -> \subst -> \t -> case (Strip.deannotateType t) of Core.TypeForall v0 -> let oldVar = Core.forallTypeParameter v0 - newVar = Core.Name (Strings.cat2 "_" (Literals.showInt32 depth)) + newVar = Core.Name (Strings.concat2 "_" (Literals.showInt32 depth)) in (go (Math.add depth 1) (Maps.insert oldVar newVar subst) (Core.forallTypeBody v0)) _ -> (subst, t) result = go 0 Maps.empty typ @@ -153,7 +154,7 @@ subst = Typing.TypeSubst (Maps.fromList (Lists.zip oldVars (Lists.map (\x -> Core.TypeVariable x) newVars))) nameSubst = Maps.fromList (Lists.zip oldVars newVars) renamedConstraints = - Optionals.map (\oldConstraints -> Maps.fromList (Lists.map (\kv -> (Optionals.fromOptional (Pairs.first kv) (Maps.lookup (Pairs.first kv) nameSubst), (Pairs.second kv))) (Maps.toList oldConstraints))) (Core.typeSchemeConstraints scheme) + Optionals.map (\oldConstraints -> Maps.fromList (Lists.map (\kv -> (Optionals.withDefault (Pairs.first kv) (Maps.lookup (Pairs.first kv) nameSubst), (Pairs.second kv))) (Maps.toList oldConstraints))) (Core.typeSchemeConstraints scheme) in ( Core.TypeScheme { Core.typeSchemeVariables = newVars, @@ -188,8 +189,8 @@ Core.TypeForall v0 -> rawType (Core.forallTypeBody v0) _ -> t in (Eithers.bind (requireType cx graph name) (\t -> Optionals.cases (getter (rawType t)) (Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { - Errors.unexpectedShapeErrorExpected = (Strings.cat2 label " type"), - Errors.unexpectedShapeErrorActual = (Strings.cat2 (Core.unName name) (Strings.cat2 ": " (ShowCore.type_ t)))})))) (\x -> Right x))) + Errors.unexpectedShapeErrorExpected = (Strings.concat2 label " type"), + Errors.unexpectedShapeErrorActual = (Strings.concat2 (Core.unName name) (Strings.concat2 ": " (PrintCore.type_ t)))})))) (\x -> Right x))) -- | Look up a schema type and instantiate it, threading InferenceContext requireSchemaType :: Typing.InferenceContext -> M.Map Core.Name Core.TypeScheme -> Core.Name -> Either Errors.Error (Core.TypeScheme, Typing.InferenceContext) diff --git a/src/main/haskell/Hydra/Rewriting.hs b/src/main/haskell/Hydra/Rewriting.hs --- a/src/main/haskell/Hydra/Rewriting.hs +++ b/src/main/haskell/Hydra/Rewriting.hs @@ -28,6 +28,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Scoping as Scoping import qualified Hydra.System as System @@ -931,21 +932,30 @@ (Paths.SubtermStepApplicationArgument, (Core.applicationArgument v0))] Core.TermCases v0 -> Lists.concat2 (Optionals.cases (Core.caseStatementDefault v0) [] (\t -> [ (Paths.SubtermStepUnionCasesDefault, t)])) (Lists.map (\f -> (Paths.SubtermStepUnionCasesBranch (Core.caseAlternativeName f), (Core.caseAlternativeHandler f))) (Core.caseStatementCases v0)) - Core.TermEither _ -> [] + Core.TermEither v0 -> [ + (Paths.SubtermStepSumTerm, (Eithers.either (\l -> l) (\r -> r) v0))] Core.TermLambda v0 -> [ (Paths.SubtermStepLambdaBody, (Core.lambdaBody v0))] Core.TermLet v0 -> Lists.cons (Paths.SubtermStepLetBody, (Core.letBody v0)) (Lists.map (\b -> (Paths.SubtermStepLetBinding (Core.bindingName b), (Core.bindingTerm b))) (Core.letBindings v0)) - Core.TermList v0 -> Lists.map (\e -> (Paths.SubtermStepListElement 0, e)) v0 + Core.TermList v0 -> Lists.map (\ip -> (Paths.SubtermStepListElement (Pairs.first ip), (Pairs.second ip))) (Lists.reverse (Pairs.second (Lists.foldl (\r -> \el -> + let idx = Pairs.first r + in (Math.add idx 1, (Lists.cons (idx, el) (Pairs.second r)))) (0, []) v0))) Core.TermLiteral _ -> [] - Core.TermMap v0 -> Lists.concat (Lists.map (\p -> [ - (Paths.SubtermStepMapKey 0, (Pairs.first p)), - (Paths.SubtermStepMapValue 0, (Pairs.second p))]) (Maps.toList v0)) + Core.TermMap v0 -> Lists.concat (Lists.map (\ip -> [ + (Paths.SubtermStepMapKey (Pairs.first ip), (Pairs.first (Pairs.second ip))), + (Paths.SubtermStepMapValue (Pairs.first ip), (Pairs.second (Pairs.second ip)))]) (Lists.reverse (Pairs.second (Lists.foldl (\r -> \el -> + let idx = Pairs.first r + in (Math.add idx 1, (Lists.cons (idx, el) (Pairs.second r)))) (0, []) (Maps.toList v0))))) Core.TermOptional v0 -> Optionals.cases v0 [] (\t -> [ (Paths.SubtermStepOptionalTerm, t)]) - Core.TermPair _ -> [] + Core.TermPair v0 -> [ + (Paths.SubtermStepProductTerm 0, (Pairs.first v0)), + (Paths.SubtermStepProductTerm 1, (Pairs.second v0))] Core.TermProject _ -> [] Core.TermRecord v0 -> Lists.map (\f -> (Paths.SubtermStepRecordField (Core.fieldName f), (Core.fieldTerm f))) (Core.recordFields v0) - Core.TermSet v0 -> Lists.map (\e -> (Paths.SubtermStepListElement 0, e)) (Sets.toList v0) + Core.TermSet v0 -> Lists.map (\ip -> (Paths.SubtermStepSetElement (Pairs.first ip), (Pairs.second ip))) (Lists.reverse (Pairs.second (Lists.foldl (\r -> \el -> + let idx = Pairs.first r + in (Math.add idx 1, (Lists.cons (idx, el) (Pairs.second r)))) (0, []) (Sets.toList v0)))) Core.TermTypeApplication v0 -> [ (Paths.SubtermStepTypeApplicationTerm, (Core.typeApplicationTermBody v0))] Core.TermTypeLambda v0 -> [ diff --git a/src/main/haskell/Hydra/Scoping.hs b/src/main/haskell/Hydra/Scoping.hs --- a/src/main/haskell/Hydra/Scoping.hs +++ b/src/main/haskell/Hydra/Scoping.hs @@ -30,6 +30,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -67,7 +68,7 @@ g2 = extendGraphWithBindings bindings g in Graph.Graph { Graph.graphBoundTerms = (Maps.union (Maps.fromList (Lists.map (\b -> (Core.bindingName b, (Core.bindingTerm b))) bindings)) (Graph.graphBoundTerms g)), - Graph.graphBoundTypes = (Maps.union (Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) bindings))) (Graph.graphBoundTypes g)), + Graph.graphBoundTypes = (Maps.union (Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) bindings))) (Graph.graphBoundTypes g)), Graph.graphClassConstraints = (Graph.graphClassConstraints g), Graph.graphLambdaVariables = (Lists.foldl (\s -> \b -> Sets.delete (Core.bindingName b) s) (Graph.graphLambdaVariables g) bindings), Graph.graphMetadata = (Graph.graphMetadata (Lists.foldl (\gAcc -> \b -> @@ -107,7 +108,7 @@ let newTerms = Maps.fromList (Lists.map (\b -> (Core.bindingName b, (Core.bindingTerm b))) bindings) newTypes = - Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) bindings)) + Maps.fromList (Optionals.givens (Lists.map (\b -> Optionals.map (\ts -> (Core.bindingName b, ts)) (Core.bindingTypeScheme b)) bindings)) in Graph.Graph { Graph.graphBoundTerms = (Maps.union newTerms (Graph.graphBoundTerms g)), Graph.graphBoundTypes = (Maps.union newTypes (Graph.graphBoundTypes g)), @@ -175,7 +176,7 @@ let variables = Core.typeSchemeVariables ts body = Core.typeSchemeBody ts - constraintsMap = Optionals.fromOptional Maps.empty (Core.typeSchemeConstraints ts) + constraintsMap = Optionals.withDefault Maps.empty (Core.typeSchemeConstraints ts) typeParams = Lists.map (\v -> Typing.TypeParameter { Typing.typeParameterName = v, @@ -193,7 +194,7 @@ i = Pairs.second acc in ( Lists.cons (Typing.Parameter { - Typing.parameterName = (Core.Name (Strings.cat [ + Typing.parameterName = (Core.Name (Strings.concat [ "arg", (Literals.showInt32 i)])), Typing.parameterDescription = Nothing, diff --git a/src/main/haskell/Hydra/Serialization.hs b/src/main/haskell/Hydra/Serialization.hs --- a/src/main/haskell/Hydra/Serialization.hs +++ b/src/main/haskell/Hydra/Serialization.hs @@ -23,12 +23,14 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -78,7 +80,7 @@ -- | Pick between an inline and a multi-line layout for the same logical expression. Returns the inline form if its estimated width does not exceed the threshold, otherwise the block form. Note: the threshold is measured against the inline expression in isolation; surrounding indentation may push content beyond the threshold at print time. Callers that know they are nested can pass a smaller threshold to compensate. chooseLayout :: Int -> Ast.Expr -> Ast.Expr -> Ast.Expr chooseLayout threshold inlineExpr blockExpr = - Logic.ifElse (Equality.gt (expressionLength inlineExpr) threshold) blockExpr inlineExpr + Logic.ifElse (Ordering.gt (expressionLength inlineExpr) threshold) blockExpr inlineExpr -- | Separate elements with a comma, using the given block style commaSep :: Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr @@ -107,12 +109,12 @@ -- | Separate the elements inside curly braces using the given symbol (default `,`) in the given block style; renders as `{}` when empty curlyBracesList :: Maybe String -> Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr curlyBracesList msymb style els = - Logic.ifElse (Lists.null els) (cst "{}") (brackets curlyBraces style (symbolSep (Optionals.fromOptional "," msymb) style els)) + Logic.ifElse (Lists.null els) (cst "{}") (brackets curlyBraces style (symbolSep (Optionals.withDefault "," msymb) style els)) -- | Indent every non-empty line of `s` by `idt`. Empty lines stay empty (no trailing whitespace) so downstream byte-identity checks don't care about indent depth. customIndent :: String -> String -> String customIndent idt s = - Strings.cat (Lists.intersperse "\n" (Lists.map (\line -> Logic.ifElse (Equality.equal line "") line (Strings.cat2 idt line)) (Strings.lines s))) + Strings.concat (Lists.intersperse "\n" (Lists.map (\line -> Logic.ifElse (Equality.equal line "") line (Strings.concat2 idt line)) (Strings.lines s))) -- | Render a list of expressions as a block whose first element starts where the surrounding context placed it and subsequent elements break onto fresh lines indented by the given prefix customIndentBlock :: String -> [Ast.Expr] -> Ast.Expr @@ -126,7 +128,7 @@ Ast.paddingRight = (Ast.WsBreakAndIndent idt)}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} - in (Optionals.cases (Lists.maybeHead els) (cst "") (\head -> Logic.ifElse (Equality.equal (Lists.length els) 1) head (ifx idtOp head (newlineSep (Lists.drop 1 els))))) + in (Optionals.cases (Lists.head els) (cst "") (\head -> Logic.ifElse (Equality.equal (Lists.length els) 1) head (ifx idtOp head (newlineSep (Lists.drop 1 els))))) -- | Separate elements with a dot and no surrounding whitespace dotSep :: [Ast.Expr] -> Ast.Expr @@ -203,7 +205,7 @@ elementLens = Lists.map expressionLength (Ast.seqExprElements se) totalElLen = Lists.foldl Math.add 0 elementLens numSeps = Math.sub (Lists.length (Ast.seqExprElements se)) 1 - in (Math.add totalElLen (Math.mul sopLen (Logic.ifElse (Equality.gt numSeps 0) numSeps 0))) + in (Math.add totalElLen (Math.mul sopLen (Logic.ifElse (Ordering.gt numSeps 0) numSeps 0))) in case e of Ast.ExprConst v0 -> symbolLength v0 Ast.ExprIndent v0 -> indentedExpressionLength v0 @@ -339,13 +341,13 @@ orSep style l = let newlines = Ast.blockStyleNewlineBeforeContent style - in (Optionals.cases (Lists.maybeHead l) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx (orOp newlines) acc el) h (Lists.drop 1 l))) + in (Optionals.cases (Lists.head l) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx (orOp newlines) acc el) h (Lists.drop 1 l))) -- | Comma-separate the elements inside parentheses; switches to a half-block style when newlines are requested and there is more than one element. Renders as `()` when empty. parenList :: Bool -> [Ast.Expr] -> Ast.Expr parenList newlines els = - let style = Logic.ifElse (Logic.and newlines (Equality.gt (Lists.length els) 1)) halfBlockStyle inlineStyle + let style = Logic.ifElse (Logic.and newlines (Ordering.gt (Lists.length els) 1)) halfBlockStyle inlineStyle in (Logic.ifElse (Lists.null els) (cst "()") (brackets parentheses style (commaSep style els))) -- | Produce a parenthesized list which separates elements by spaces or newlines depending on the estimated width of the expression. @@ -401,7 +403,7 @@ let lop = Ast.opExprOp v1 lprec = Ast.unPrecedence (Ast.opPrecedence lop) lassoc = Ast.opAssociativity lop - comparison = Equality.compare prec lprec + comparison = Ordering.compare prec lprec in case comparison of Util.ComparisonLessThan -> lhs_ Util.ComparisonGreaterThan -> parens lhs_ @@ -413,7 +415,7 @@ let rop = Ast.opExprOp v1 rprec = Ast.unPrecedence (Ast.opPrecedence rop) rassoc = Ast.opAssociativity rop - comparison = Equality.compare prec rprec + comparison = Ordering.compare prec rprec in case comparison of Util.ComparisonLessThan -> rhs_ Util.ComparisonGreaterThan -> parens rhs_ @@ -459,12 +461,12 @@ let style = Ast.indentedExpressionStyle v0 expr = Ast.indentedExpressionExpr v0 lns = Strings.lines (printExpr expr) - indentLine = \pre -> \line -> Logic.ifElse (Equality.equal line "") line (Strings.cat2 pre line) + indentLine = \pre -> \line -> Logic.ifElse (Equality.equal line "") line (Strings.concat2 pre line) ilns = case style of Ast.IndentStyleAllLines v1 -> Lists.map (indentLine v1) lns - Ast.IndentStyleSubsequentLines v1 -> Logic.ifElse (Equality.equal (Lists.length lns) 1) lns (Optionals.fromOptional lns (Optionals.map (\uc -> Lists.cons (Pairs.first uc) (Lists.map (indentLine v1) (Pairs.second uc))) (Lists.uncons lns))) - in (Strings.intercalate "\n" ilns) + Ast.IndentStyleSubsequentLines v1 -> Logic.ifElse (Equality.equal (Lists.length lns) 1) lns (Optionals.withDefault lns (Optionals.map (\uc -> Lists.cons (Pairs.first uc) (Lists.map (indentLine v1) (Pairs.second uc))) (Lists.uncons lns))) + in (Strings.join "\n" ilns) Ast.ExprSeq v0 -> let sop = Ast.seqExprOp v0 ssym = Ast.unSymbol (Ast.opSymbol sop) @@ -483,19 +485,19 @@ spadrIsNewline = isNewlineWs spadr joinElements = \acc -> \el -> - let elStartsWithNewline = Optionals.cases (Strings.maybeCharAt 0 el) False (\c -> Equality.equal c 10) + let elStartsWithNewline = Optionals.cases (Strings.charAt 0 el) False (\c -> Equality.equal c 10) elIsEmpty = Equality.equal el "" padlEff = Logic.ifElse (Logic.or (Logic.and elStartsWithNewline (Logic.not spadlIsNewline)) (Logic.and elIsEmpty (Equality.equal ssym ""))) "" (pad spadl) padrEff = Logic.ifElse (Logic.or (Logic.and elStartsWithNewline (Logic.not spadrIsNewline)) (Logic.and elIsEmpty (Equality.equal ssym ""))) "" (pad spadr) - in (Strings.cat [ + in (Strings.concat [ acc, padlEff, ssym, padrEff, el]) - in (Optionals.cases (Lists.maybeHead printedElements) "" (\h -> Lists.foldl joinElements h (Lists.drop 1 printedElements))) + in (Optionals.cases (Lists.head printedElements) "" (\h -> Lists.foldl joinElements h (Lists.drop 1 printedElements))) Ast.ExprOp v0 -> let op = Ast.opExprOp v0 sym = Ast.unSymbol (Ast.opSymbol op) @@ -520,9 +522,9 @@ padlEffective = Logic.ifElse (Logic.and (Logic.not padlIsNewline) (Logic.and (Equality.equal sym "") (Logic.or padrIsNewline (Equality.equal rhs "")))) "" (pad padl) padrPad = pad padr - rhsStartsWithNewline = Optionals.cases (Strings.maybeCharAt 0 rhs) False (\c -> Equality.equal c 10) + rhsStartsWithNewline = Optionals.cases (Strings.charAt 0 rhs) False (\c -> Equality.equal c 10) padrEffective = Logic.ifElse (Logic.and rhsStartsWithNewline (Logic.not padrIsNewline)) "" padrPad - in (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 lhs padlEffective) sym) padrEffective) rhs) + in (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 lhs padlEffective) sym) padrEffective) rhs) Ast.ExprBrackets v0 -> let brs = Ast.bracketExprBrackets v0 l = Ast.unSymbol (Ast.bracketsOpen brs) @@ -536,7 +538,7 @@ ibody = Optionals.cases doIndent body (\pre -> customIndent pre body) pre = Logic.ifElse nlBefore "\n" "" suf = Logic.ifElse nlAfter "\n" "" - in (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 l pre) ibody) suf) r) + in (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 l pre) ibody) suf) r) -- | Separate elements with `;` inline semicolonSep :: [Ast.Expr] -> Ast.Expr @@ -544,8 +546,7 @@ -- | Combine a list of expressions into a single OpExpr chain using the given operator. Returns the empty constant for an empty list. sep :: Ast.Op -> [Ast.Expr] -> Ast.Expr -sep op els = - Optionals.cases (Lists.maybeHead els) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx op acc el) h (Lists.drop 1 els)) +sep op els = Optionals.cases (Lists.head els) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx op acc el) h (Lists.drop 1 els)) -- | Space-separate elements (no break between them) spaceSep :: [Ast.Expr] -> Ast.Expr @@ -572,7 +573,7 @@ -- | Like sep, but produces a SeqExpr instead of an OpExpr chain. SeqExpr is treated as structural layout and is not subject to parenthesization. structuralSep :: Ast.Op -> [Ast.Expr] -> Ast.Expr structuralSep op els = - Logic.ifElse (Lists.null els) (cst "") (Logic.ifElse (Equality.equal (Lists.length els) 1) (Optionals.fromOptional (cst "") (Lists.maybeHead els)) (Ast.ExprSeq (Ast.SeqExpr { + Logic.ifElse (Lists.null els) (cst "") (Logic.ifElse (Equality.equal (Lists.length els) 1) (Optionals.withDefault (cst "") (Lists.head els)) (Ast.ExprSeq (Ast.SeqExpr { Ast.seqExprOp = op, Ast.seqExprElements = els}))) @@ -623,7 +624,7 @@ Ast.paddingRight = break}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} - in (Optionals.cases (Lists.maybeHead l) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx commaOp acc el) h (Lists.drop 1 l))) + in (Optionals.cases (Lists.head l) (cst "") (\h -> Lists.foldl (\acc -> \el -> ifx commaOp acc el) h (Lists.drop 1 l))) -- | Indent every line of an expression by four spaces tabIndent :: Ast.Expr -> Ast.Expr @@ -642,12 +643,12 @@ -- | Render a placeholder for a type the writer does not yet handle, e.g. `[bigint]` unsupportedType :: String -> Ast.Expr -unsupportedType label = cst (Strings.cat2 (Strings.cat2 "[" label) "]") +unsupportedType label = cst (Strings.concat2 (Strings.concat2 "[" label) "]") -- | Render a placeholder for an unsupported variant, including a string representation of the offending value unsupportedVariant :: String -> String -> Ast.Expr unsupportedVariant label obj = - cst (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 "[unsupported " label) ": ") (Literals.showString obj)) "]") + cst (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "[unsupported " label) ": ") (Literals.printString obj)) "]") -- | Append a trailing comma to an expression withComma :: Ast.Expr -> Ast.Expr diff --git a/src/main/haskell/Hydra/Show/Core.hs b/src/main/haskell/Hydra/Show/Core.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Core.hs +++ /dev/null @@ -1,535 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.core types - -module Hydra.Show.Core where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals -import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic -import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps -import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci -import qualified Data.Map as M -import qualified Data.Set as S - --- | Show a binding as a string -binding :: Core.Binding -> String -binding el = - - let name = Core.unName (Core.bindingName el) - t = Core.bindingTerm el - typeStr = - Optionals.cases (Core.bindingTypeScheme el) "" (\ts -> Strings.cat [ - ":(", - (typeScheme ts), - ")"]) - in (Strings.cat [ - name, - typeStr, - " = ", - (term t)]) - --- | Show a case statement as a string -caseStatement :: Core.CaseStatement -> String -caseStatement cs = - - let tname = Core.unName (Core.caseStatementTypeName cs) - mdef = Core.caseStatementDefault cs - csCases = Core.caseStatementCases cs - caseFields = - Lists.map (\alt -> Core.Field { - Core.fieldName = (Core.caseAlternativeName alt), - Core.fieldTerm = (Core.caseAlternativeHandler alt)}) csCases - defaultField = - Optionals.cases mdef [] (\d -> [ - Core.Field { - Core.fieldName = (Core.Name "[default]"), - Core.fieldTerm = d}]) - allFields = - Lists.concat [ - caseFields, - defaultField] - in (Strings.cat [ - "case(", - tname, - ")", - (fields allFields)]) - --- | Show an Either value using given functions for left and right -either :: (t0 -> String) -> (t1 -> String) -> Either t0 t1 -> String -either showA showB e = - Eithers.either (\a -> Strings.cat2 "left(" (Strings.cat2 (showA a) ")")) (\b -> Strings.cat2 "right(" (Strings.cat2 (showB b) ")")) e - --- | Show a field as a string -field :: Core.Field -> String -field field = - - let fname = Core.unName (Core.fieldName field) - fterm = Core.fieldTerm field - in (Strings.cat [ - fname, - "=", - (term fterm)]) - --- | Show a field type as a string -fieldType :: Core.FieldType -> String -fieldType ft = - - let fname = Core.unName (Core.fieldTypeName ft) - ftyp = Core.fieldTypeType ft - in (Strings.cat [ - fname, - ":", - (type_ ftyp)]) - --- | Show a list of fields as a string -fields :: [Core.Field] -> String -fields flds = - - let fieldStrs = Lists.map field flds - in (Strings.cat [ - "{", - (Strings.intercalate ", " fieldStrs), - "}"]) - --- | Show a float value as a string -float :: Core.FloatValue -> String -float fv = - case fv of - Core.FloatValueFloat32 v0 -> Strings.cat2 (Literals.showFloat32 v0) ":float32" - Core.FloatValueFloat64 v0 -> Strings.cat2 (Literals.showFloat64 v0) ":float64" - --- | Show a float type as a string -floatType :: Core.FloatType -> String -floatType ft = - case ft of - Core.FloatTypeFloat32 -> "float32" - Core.FloatTypeFloat64 -> "float64" - --- | Show an injection as a string -injection :: Core.Injection -> String -injection inj = - - let tname = Core.injectionTypeName inj - f = Core.injectionField inj - in (Strings.cat [ - "inject(", - (Core.unName tname), - ")", - (fields [ - f])]) - --- | Show an integer value as a string -integer :: Core.IntegerValue -> String -integer iv = - case iv of - Core.IntegerValueBigint v0 -> Strings.cat2 (Literals.showBigint v0) ":bigint" - Core.IntegerValueInt8 v0 -> Strings.cat2 (Literals.showInt8 v0) ":int8" - Core.IntegerValueInt16 v0 -> Strings.cat2 (Literals.showInt16 v0) ":int16" - Core.IntegerValueInt32 v0 -> Strings.cat2 (Literals.showInt32 v0) ":int32" - Core.IntegerValueInt64 v0 -> Strings.cat2 (Literals.showInt64 v0) ":int64" - Core.IntegerValueUint8 v0 -> Strings.cat2 (Literals.showUint8 v0) ":uint8" - Core.IntegerValueUint16 v0 -> Strings.cat2 (Literals.showUint16 v0) ":uint16" - Core.IntegerValueUint32 v0 -> Strings.cat2 (Literals.showUint32 v0) ":uint32" - Core.IntegerValueUint64 v0 -> Strings.cat2 (Literals.showUint64 v0) ":uint64" - --- | Show an integer type as a string -integerType :: Core.IntegerType -> String -integerType it = - case it of - Core.IntegerTypeBigint -> "bigint" - Core.IntegerTypeInt8 -> "int8" - Core.IntegerTypeInt16 -> "int16" - Core.IntegerTypeInt32 -> "int32" - Core.IntegerTypeInt64 -> "int64" - Core.IntegerTypeUint8 -> "uint8" - Core.IntegerTypeUint16 -> "uint16" - Core.IntegerTypeUint32 -> "uint32" - Core.IntegerTypeUint64 -> "uint64" - --- | Show a lambda as a string -lambda :: Core.Lambda -> String -lambda l = - - let v = Core.unName (Core.lambdaParameter l) - mt = Core.lambdaDomain l - body = Core.lambdaBody l - typeStr = Optionals.cases mt "" (\t -> Strings.cat2 ":" (type_ t)) - in (Strings.cat [ - "\955", - v, - typeStr, - ".", - (term body)]) - --- | Show a let expression as a string -let_ :: Core.Let -> String -let_ l = - - let bindings = Core.letBindings l - env = Core.letBody l - bindingStrs = Lists.map binding bindings - in (Strings.cat [ - "let ", - (Strings.intercalate ", " bindingStrs), - " in ", - (term env)]) - --- | Show a list using a given function to show each element -list :: (t0 -> String) -> [t0] -> String -list f xs = - - let elementStrs = Lists.map f xs - in (Strings.cat [ - "[", - (Strings.intercalate ", " elementStrs), - "]"]) - --- | Show a literal as a string -literal :: Core.Literal -> String -literal l = - case l of - Core.LiteralBinary _ -> "[binary]" - Core.LiteralBoolean v0 -> Logic.ifElse v0 "true" "false" - Core.LiteralDecimal v0 -> Literals.showDecimal v0 - Core.LiteralFloat v0 -> float v0 - Core.LiteralInteger v0 -> integer v0 - Core.LiteralString v0 -> Literals.showString v0 - --- | Show a literal type as a string -literalType :: Core.LiteralType -> String -literalType lt = - case lt of - Core.LiteralTypeBinary -> "binary" - Core.LiteralTypeBoolean -> "boolean" - Core.LiteralTypeDecimal -> "decimal" - Core.LiteralTypeFloat v0 -> floatType v0 - Core.LiteralTypeInteger v0 -> integerType v0 - Core.LiteralTypeString -> "string" - --- | Show a map using given functions to show keys and values -map :: Ord t0 => ((t0 -> String) -> (t1 -> String) -> M.Map t0 t1 -> String) -map showK showV m = - - let pairStrs = - Lists.map (\p -> Strings.cat [ - showK (Pairs.first p), - ": ", - (showV (Pairs.second p))]) (Maps.toList m) - in (Strings.cat [ - "{", - (Strings.intercalate ", " pairStrs), - "}"]) - --- | Show an optional value using a given function to show the element -optional :: (t0 -> String) -> Maybe t0 -> String -optional f mx = Optionals.cases mx "none" (\x -> Strings.cat2 "given(" (Strings.cat2 (f x) ")")) - --- | Show a pair using given functions to show each element -pair :: (t0 -> String) -> (t1 -> String) -> (t0, t1) -> String -pair showA showB p = - Strings.cat [ - "(", - (showA (Pairs.first p)), - ", ", - (showB (Pairs.second p)), - ")"] - --- | Show a projection as a string -projection :: Core.Projection -> String -projection proj = - - let tname = Core.unName (Core.projectionTypeName proj) - fname = Core.unName (Core.projectionFieldName proj) - in (Strings.cat [ - "project(", - tname, - "){", - fname, - "}"]) - --- | A placeholder for reading terms from their serialized form. Not implemented. -readTerm :: String -> Maybe Core.Term -readTerm s = Just (Core.TermLiteral (Core.LiteralString s)) - --- | Show a set using a given function to show each element -set :: Ord t0 => ((t0 -> String) -> S.Set t0 -> String) -set f xs = - - let elementStrs = Lists.map f (Sets.toList xs) - in (Strings.cat [ - "{", - (Strings.intercalate ", " elementStrs), - "}"]) - --- | Show a term as a string -term :: Core.Term -> String -term t = - - let gatherTerms = - \prev -> \app -> - let lhs = Core.applicationFunction app - rhs = Core.applicationArgument app - in case lhs of - Core.TermApplication v0 -> gatherTerms (Lists.cons rhs prev) v0 - _ -> Lists.cons lhs (Lists.cons rhs prev) - in case t of - Core.TermAnnotated v0 -> term (Core.annotatedTermBody v0) - Core.TermApplication v0 -> - let terms = gatherTerms [] v0 - termStrs = Lists.map term terms - in (Strings.cat [ - "(", - (Strings.intercalate " @ " termStrs), - ")"]) - Core.TermCases v0 -> caseStatement v0 - Core.TermEither v0 -> Eithers.either (\l -> Strings.cat [ - "left(", - (term l), - ")"]) (\r -> Strings.cat [ - "right(", - (term r), - ")"]) v0 - Core.TermLambda v0 -> lambda v0 - Core.TermLet v0 -> let_ v0 - Core.TermList v0 -> - let termStrs = Lists.map term v0 - in (Strings.cat [ - "[", - (Strings.intercalate ", " termStrs), - "]"]) - Core.TermLiteral v0 -> literal v0 - Core.TermMap v0 -> - let entry = - \p -> Strings.cat [ - term (Pairs.first p), - "=", - (term (Pairs.second p))] - in (Strings.cat [ - "{", - (Strings.intercalate ", " (Lists.map entry (Maps.toList v0))), - "}"]) - Core.TermOptional v0 -> Optionals.cases v0 "none" (\t2 -> Strings.cat [ - "given(", - (term t2), - ")"]) - Core.TermPair v0 -> Strings.cat [ - "(", - (term (Pairs.first v0)), - ", ", - (term (Pairs.second v0)), - ")"] - Core.TermProject v0 -> projection v0 - Core.TermRecord v0 -> - let tname = Core.unName (Core.recordTypeName v0) - flds = Core.recordFields v0 - in (Strings.cat [ - "record(", - tname, - ")", - (fields flds)]) - Core.TermSet v0 -> Strings.cat [ - "{", - (Strings.intercalate ", " (Lists.map term (Sets.toList v0))), - "}"] - Core.TermTypeLambda v0 -> - let param = Core.unName (Core.typeLambdaParameter v0) - body = Core.typeLambdaBody v0 - in (Strings.cat [ - "\923", - param, - ".", - (term body)]) - Core.TermTypeApplication v0 -> - let t2 = Core.typeApplicationTermBody v0 - typ = Core.typeApplicationTermType v0 - in (Strings.cat [ - term t2, - "\10216", - (type_ typ), - "\10217"]) - Core.TermInject v0 -> injection v0 - Core.TermUnit -> "unit" - Core.TermUnwrap v0 -> Strings.cat [ - "unwrap(", - (Core.unName v0), - ")"] - Core.TermVariable v0 -> Core.unName v0 - Core.TermWrap v0 -> - let tname = Core.unName (Core.wrappedTermTypeName v0) - term1 = Core.wrappedTermBody v0 - in (Strings.cat [ - "wrap(", - tname, - "){", - (term term1), - "}"]) - --- | Show a type as a string -type_ :: Core.Type -> String -type_ typ = - - let showRowType = - \flds -> - let fieldStrs = Lists.map fieldType flds - in (Strings.cat [ - "{", - (Strings.intercalate ", " fieldStrs), - "}"]) - gatherTypes = - \prev -> \app -> - let lhs = Core.applicationTypeFunction app - rhs = Core.applicationTypeArgument app - in case lhs of - Core.TypeApplication v0 -> gatherTypes (Lists.cons rhs prev) v0 - _ -> Lists.cons lhs (Lists.cons rhs prev) - gatherFunctionTypes = - \prev -> \t -> case t of - Core.TypeFunction v0 -> - let dom = Core.functionTypeDomain v0 - cod = Core.functionTypeCodomain v0 - in (gatherFunctionTypes (Lists.cons dom prev) cod) - _ -> Lists.reverse (Lists.cons t prev) - in case typ of - Core.TypeAnnotated v0 -> type_ (Core.annotatedTypeBody v0) - Core.TypeApplication v0 -> - let types = gatherTypes [] v0 - typeStrs = Lists.map type_ types - in (Strings.cat [ - "(", - (Strings.intercalate " @ " typeStrs), - ")"]) - Core.TypeEffect v0 -> Strings.cat [ - "effect<", - (type_ v0), - ">"] - Core.TypeEither v0 -> - let leftTyp = Core.eitherTypeLeft v0 - rightTyp = Core.eitherTypeRight v0 - in (Strings.cat [ - "either<", - (type_ leftTyp), - ", ", - (type_ rightTyp), - ">"]) - Core.TypeForall v0 -> - let var = Core.unName (Core.forallTypeParameter v0) - body = Core.forallTypeBody v0 - in (Strings.cat [ - "(\8704", - var, - ".", - (type_ body), - ")"]) - Core.TypeFunction _ -> - let types = gatherFunctionTypes [] typ - typeStrs = Lists.map type_ types - in (Strings.cat [ - "(", - (Strings.intercalate " \8594 " typeStrs), - ")"]) - Core.TypeList v0 -> Strings.cat [ - "list<", - (type_ v0), - ">"] - Core.TypeLiteral v0 -> literalType v0 - Core.TypeMap v0 -> - let keyTyp = Core.mapTypeKeys v0 - valTyp = Core.mapTypeValues v0 - in (Strings.cat [ - "map<", - (type_ keyTyp), - ", ", - (type_ valTyp), - ">"]) - Core.TypeOptional v0 -> Strings.cat [ - "optional<", - (type_ v0), - ">"] - Core.TypePair v0 -> - let firstTyp = Core.pairTypeFirst v0 - secondTyp = Core.pairTypeSecond v0 - in (Strings.cat [ - "(", - (type_ firstTyp), - ", ", - (type_ secondTyp), - ")"]) - Core.TypeRecord v0 -> Strings.cat2 "record" (showRowType v0) - Core.TypeSet v0 -> Strings.cat [ - "set<", - (type_ v0), - ">"] - Core.TypeUnion v0 -> Strings.cat2 "union" (showRowType v0) - Core.TypeUnit -> "unit" - Core.TypeVariable v0 -> Core.unName v0 - Core.TypeVoid -> "void" - Core.TypeWrap v0 -> Strings.cat [ - "wrap(", - (type_ v0), - ")"] - --- | Show a type scheme as a string -typeScheme :: Core.TypeScheme -> String -typeScheme ts = - - let vars = Core.typeSchemeVariables ts - body = Core.typeSchemeBody ts - varNames = Lists.map Core.unName vars - fa = - Logic.ifElse (Lists.null vars) "" (Strings.cat [ - "forall ", - (Strings.intercalate "," varNames), - ". "]) - toConstraintPair = - \v -> \c -> Strings.cat [ - case c of - Core.TypeClassConstraintSimple v0 -> Core.unName v0, - " ", - (Core.unName v)] - toConstraintPairs = - \p -> Lists.map (toConstraintPair (Pairs.first p)) (Core.typeVariableConstraintsClasses (Pairs.second p)) - tc = Optionals.cases (Core.typeSchemeConstraints ts) [] (\m -> Lists.concat (Lists.map toConstraintPairs (Maps.toList m))) - in (Strings.cat [ - "(", - fa, - (Logic.ifElse (Lists.null tc) "" (Strings.cat [ - "(", - (Strings.intercalate ", " tc), - ") => "])), - (type_ body), - ")"]) diff --git a/src/main/haskell/Hydra/Show/Docs.hs b/src/main/haskell/Hydra/Show/Docs.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Docs.hs +++ /dev/null @@ -1,87 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.docs types - -module Hydra.Show.Docs where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Read.Docs as ReadDocs -import qualified Hydra.Relational as Relational -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Render a DefinitionReference as its fully-qualified name -definitionReference :: Packaging.DefinitionReference -> String -definitionReference x = - case x of - Packaging.DefinitionReferencePrimitive v0 -> Core.unName v0 - Packaging.DefinitionReferenceTerm v0 -> Core.unName v0 - Packaging.DefinitionReferenceType v0 -> Core.unName v0 - --- | Render a single DocSegment back to its source string form -docSegment :: Docs.DocSegment -> String -docSegment seg = docSegmentWith entityReference seg - --- | Render a single DocSegment using a custom 'EntityReference' renderer -docSegmentWith :: (Packaging.EntityReference -> String) -> Docs.DocSegment -> String -docSegmentWith render x = - case x of - Docs.DocSegmentRef v0 -> render v0 - Docs.DocSegmentText v0 -> v0 - --- | Render a list of DocSegments back to a plain documentation string -docSegments :: [Docs.DocSegment] -> String -docSegments segs = Strings.cat (Lists.map docSegment segs) - --- | Render a list of DocSegments using a custom 'EntityReference' renderer -docSegmentsWith :: (Packaging.EntityReference -> String) -> [Docs.DocSegment] -> String -docSegmentsWith render segs = Strings.cat (Lists.map (docSegmentWith render) segs) - --- | Render a 'EntityReference' as its doc-escape tag string (without the surrounding braces) -entityReference :: Packaging.EntityReference -> String -entityReference x = - case x of - Packaging.EntityReferenceDefinition v0 -> Strings.cat2 (case v0 of - Packaging.DefinitionReferencePrimitive _ -> "primitive" - Packaging.DefinitionReferenceTerm _ -> "term" - Packaging.DefinitionReferenceType _ -> "type") (Strings.cat2 " " (definitionReference v0)) - Packaging.EntityReferenceModule v0 -> Strings.cat2 "module " (Packaging.unModuleName v0) - Packaging.EntityReferencePackage v0 -> Strings.cat2 "package " (Packaging.unPackageName v0) - Packaging.EntityReferenceTermExpr v0 -> Strings.cat2 "term-expr " v0 - Packaging.EntityReferenceTypeExpr v0 -> Strings.cat2 "type-expr " v0 - --- | Parse a documentation string and re-render it, converting doc-escape tags through their canonical form -renderDocString :: String -> String -renderDocString s = renderDocStringWith entityReference s - --- | Parse a documentation string and render it using a custom 'EntityReference' renderer. Text segments are passed through; ref segments are rendered by the provided function. Unrecognized doc-escape blocks are passed through as text. -renderDocStringWith :: (Packaging.EntityReference -> String) -> String -> String -renderDocStringWith render s = docSegmentsWith render (ReadDocs.parseDocString s) diff --git a/src/main/haskell/Hydra/Show/Error/Core.hs b/src/main/haskell/Hydra/Show/Error/Core.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Error/Core.hs +++ /dev/null @@ -1,345 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.error.core types - -module Hydra.Show.Error.Core where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Variants as ShowVariants -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a constant condition error as a string -constantConditionError :: ErrorCore.ConstantConditionError -> String -constantConditionError e = - Strings.cat [ - "constant condition: ifElse with literal ", - (Literals.showBoolean (ErrorCore.constantConditionErrorValue e))] - --- | Show a duplicate binding error as a string -duplicateBindingError :: ErrorCore.DuplicateBindingError -> String -duplicateBindingError e = - Strings.cat [ - "duplicate binding: ", - (Core.unName (ErrorCore.duplicateBindingErrorName e))] - --- | Show a duplicate field error as a string -duplicateFieldError :: ErrorCore.DuplicateFieldError -> String -duplicateFieldError e = - Strings.cat [ - "duplicate field: ", - (Core.unName (ErrorCore.duplicateFieldErrorName e))] - --- | Show a duplicate record type field names error as a string -duplicateRecordTypeFieldNamesError :: ErrorCore.DuplicateRecordTypeFieldNamesError -> String -duplicateRecordTypeFieldNamesError e = - Strings.cat [ - "duplicate field in record type: ", - (Core.unName (ErrorCore.duplicateRecordTypeFieldNamesErrorName e))] - --- | Show a duplicate union type field names error as a string -duplicateUnionTypeFieldNamesError :: ErrorCore.DuplicateUnionTypeFieldNamesError -> String -duplicateUnionTypeFieldNamesError e = - Strings.cat [ - "duplicate field in union type: ", - (Core.unName (ErrorCore.duplicateUnionTypeFieldNamesErrorName e))] - --- | Show an empty case statement error as a string -emptyCaseStatementError :: ErrorCore.EmptyCaseStatementError -> String -emptyCaseStatementError e = - Strings.cat [ - "empty case statement for type: ", - (Core.unName (ErrorCore.emptyCaseStatementErrorTypeName e))] - --- | Show an empty let bindings error as a string -emptyLetBindingsError :: t0 -> String -emptyLetBindingsError e = "let expression with no bindings" - --- | Show an empty record type error as a string -emptyRecordTypeError :: t0 -> String -emptyRecordTypeError e = "record type with no fields (use TypeUnit instead)" - --- | Show an empty term annotation error as a string -emptyTermAnnotationError :: t0 -> String -emptyTermAnnotationError e = "term annotation with empty annotation map" - --- | Show an empty type annotation error as a string -emptyTypeAnnotationError :: t0 -> String -emptyTypeAnnotationError e = "type annotation with empty annotation map" - --- | Show an empty type name in term error as a string -emptyTypeNameInTermError :: t0 -> String -emptyTypeNameInTermError e = "term with empty type name" - --- | Show an empty union type error as a string -emptyUnionTypeError :: t0 -> String -emptyUnionTypeError e = "union type with no alternatives (use TypeVoid instead)" - --- | Show an invalid forall parameter name error as a string -invalidForallParameterNameError :: ErrorCore.InvalidForallParameterNameError -> String -invalidForallParameterNameError e = - Strings.cat [ - "invalid forall parameter name: ", - (Core.unName (ErrorCore.invalidForallParameterNameErrorName e))] - --- | Show an invalid lambda parameter name error as a string -invalidLambdaParameterNameError :: ErrorCore.InvalidLambdaParameterNameError -> String -invalidLambdaParameterNameError e = - Strings.cat [ - "invalid lambda parameter name: ", - (Core.unName (ErrorCore.invalidLambdaParameterNameErrorName e))] - --- | Show an invalid let binding name error as a string -invalidLetBindingNameError :: ErrorCore.InvalidLetBindingNameError -> String -invalidLetBindingNameError e = - Strings.cat [ - "invalid let binding name: ", - (Core.unName (ErrorCore.invalidLetBindingNameErrorName e))] - --- | Show an invalid term error as a string -invalidTermError :: ErrorCore.InvalidTermError -> String -invalidTermError e = - Strings.cat2 "invalid term: " (case e of - ErrorCore.InvalidTermErrorConstantCondition v0 -> constantConditionError v0 - ErrorCore.InvalidTermErrorDuplicateBinding v0 -> duplicateBindingError v0 - ErrorCore.InvalidTermErrorDuplicateField v0 -> duplicateFieldError v0 - ErrorCore.InvalidTermErrorEmptyCaseStatement v0 -> emptyCaseStatementError v0 - ErrorCore.InvalidTermErrorEmptyLetBindings v0 -> emptyLetBindingsError v0 - ErrorCore.InvalidTermErrorEmptyTermAnnotation v0 -> emptyTermAnnotationError v0 - ErrorCore.InvalidTermErrorEmptyTypeNameInTerm v0 -> emptyTypeNameInTermError v0 - ErrorCore.InvalidTermErrorInvalidLambdaParameterName v0 -> invalidLambdaParameterNameError v0 - ErrorCore.InvalidTermErrorInvalidLetBindingName v0 -> invalidLetBindingNameError v0 - ErrorCore.InvalidTermErrorInvalidTypeLambdaParameterName v0 -> invalidTypeLambdaParameterNameError v0 - ErrorCore.InvalidTermErrorNestedTermAnnotation v0 -> nestedTermAnnotationError v0 - ErrorCore.InvalidTermErrorRedundantWrapUnwrap v0 -> redundantWrapUnwrapError v0 - ErrorCore.InvalidTermErrorSelfApplication v0 -> selfApplicationError v0 - ErrorCore.InvalidTermErrorTermVariableShadowing v0 -> termVariableShadowingError v0 - ErrorCore.InvalidTermErrorTypeVariableShadowingInTypeLambda v0 -> typeVariableShadowingInTypeLambdaError v0 - ErrorCore.InvalidTermErrorUndefinedTermVariable v0 -> undefinedTermVariableError v0 - ErrorCore.InvalidTermErrorUndefinedTypeVariableInBindingType v0 -> undefinedTypeVariableInBindingTypeError v0 - ErrorCore.InvalidTermErrorUndefinedTypeVariableInLambdaDomain v0 -> undefinedTypeVariableInLambdaDomainError v0 - ErrorCore.InvalidTermErrorUndefinedTypeVariableInTypeApplication v0 -> undefinedTypeVariableInTypeApplicationError v0 - ErrorCore.InvalidTermErrorUnknownPrimitiveName v0 -> unknownPrimitiveNameError v0 - ErrorCore.InvalidTermErrorUnnecessaryIdentityApplication v0 -> unnecessaryIdentityApplicationError v0 - ErrorCore.InvalidTermErrorUntypedTermVariable v0 -> untypedTermVariableError v0) - --- | Show an invalid type error as a string -invalidTypeError :: ErrorCore.InvalidTypeError -> String -invalidTypeError e = - Strings.cat2 "invalid type: " (case e of - ErrorCore.InvalidTypeErrorDuplicateRecordTypeFieldNames v0 -> duplicateRecordTypeFieldNamesError v0 - ErrorCore.InvalidTypeErrorDuplicateUnionTypeFieldNames v0 -> duplicateUnionTypeFieldNamesError v0 - ErrorCore.InvalidTypeErrorEmptyRecordType v0 -> emptyRecordTypeError v0 - ErrorCore.InvalidTypeErrorEmptyTypeAnnotation v0 -> emptyTypeAnnotationError v0 - ErrorCore.InvalidTypeErrorEmptyUnionType v0 -> emptyUnionTypeError v0 - ErrorCore.InvalidTypeErrorInvalidForallParameterName v0 -> invalidForallParameterNameError v0 - ErrorCore.InvalidTypeErrorInvalidTypeSchemeVariableName v0 -> invalidTypeSchemeVariableNameError v0 - ErrorCore.InvalidTypeErrorNestedTypeAnnotation v0 -> nestedTypeAnnotationError v0 - ErrorCore.InvalidTypeErrorNonComparableMapKeyType v0 -> nonComparableMapKeyTypeError v0 - ErrorCore.InvalidTypeErrorNonComparableSetElementType v0 -> nonComparableSetElementTypeError v0 - ErrorCore.InvalidTypeErrorSingleVariantUnion v0 -> singleVariantUnionError v0 - ErrorCore.InvalidTypeErrorTypeVariableShadowingInForall v0 -> typeVariableShadowingInForallError v0 - ErrorCore.InvalidTypeErrorUndefinedTypeVariable v0 -> undefinedTypeVariableError v0 - ErrorCore.InvalidTypeErrorVoidInNonBottomPosition v0 -> voidInNonBottomPositionError v0) - --- | Show an invalid type lambda parameter name error as a string -invalidTypeLambdaParameterNameError :: ErrorCore.InvalidTypeLambdaParameterNameError -> String -invalidTypeLambdaParameterNameError e = - Strings.cat [ - "invalid type lambda parameter name: ", - (Core.unName (ErrorCore.invalidTypeLambdaParameterNameErrorName e))] - --- | Show an invalid type scheme variable name error as a string -invalidTypeSchemeVariableNameError :: ErrorCore.InvalidTypeSchemeVariableNameError -> String -invalidTypeSchemeVariableNameError e = - Strings.cat [ - "invalid type scheme variable name: ", - (Core.unName (ErrorCore.invalidTypeSchemeVariableNameErrorName e))] - --- | Show a nested term annotation error as a string -nestedTermAnnotationError :: t0 -> String -nestedTermAnnotationError e = "nested term annotations should be merged" - --- | Show a nested type annotation error as a string -nestedTypeAnnotationError :: t0 -> String -nestedTypeAnnotationError e = "nested type annotations should be merged" - --- | Show a non-comparable map key type error as a string -nonComparableMapKeyTypeError :: ErrorCore.NonComparableMapKeyTypeError -> String -nonComparableMapKeyTypeError e = - Strings.cat [ - "map key type contains a function type: ", - (ShowCore.type_ (ErrorCore.nonComparableMapKeyTypeErrorKeyType e))] - --- | Show a non-comparable set element type error as a string -nonComparableSetElementTypeError :: ErrorCore.NonComparableSetElementTypeError -> String -nonComparableSetElementTypeError e = - Strings.cat [ - "set element type contains a function type: ", - (ShowCore.type_ (ErrorCore.nonComparableSetElementTypeErrorElementType e))] - --- | Show a redundant wrap/unwrap error as a string -redundantWrapUnwrapError :: ErrorCore.RedundantWrapUnwrapError -> String -redundantWrapUnwrapError e = - Strings.cat [ - "redundant wrap/unwrap for type: ", - (Core.unName (ErrorCore.redundantWrapUnwrapErrorTypeName e))] - --- | Show a self-application error as a string -selfApplicationError :: ErrorCore.SelfApplicationError -> String -selfApplicationError e = - Strings.cat [ - "self-application of variable: ", - (Core.unName (ErrorCore.selfApplicationErrorName e))] - --- | Show a single variant union error as a string -singleVariantUnionError :: ErrorCore.SingleVariantUnionError -> String -singleVariantUnionError e = - Strings.cat [ - "union type with single variant: ", - (Core.unName (ErrorCore.singleVariantUnionErrorFieldName e))] - --- | Show a term variable shadowing error as a string -termVariableShadowingError :: ErrorCore.TermVariableShadowingError -> String -termVariableShadowingError e = - Strings.cat [ - "variable shadowing: ", - (Core.unName (ErrorCore.termVariableShadowingErrorName e))] - --- | Show a type variable shadowing in forall error as a string -typeVariableShadowingInForallError :: ErrorCore.TypeVariableShadowingInForallError -> String -typeVariableShadowingInForallError e = - Strings.cat [ - "type variable shadowing in forall: ", - (Core.unName (ErrorCore.typeVariableShadowingInForallErrorName e))] - --- | Show a type variable shadowing in type lambda error as a string -typeVariableShadowingInTypeLambdaError :: ErrorCore.TypeVariableShadowingInTypeLambdaError -> String -typeVariableShadowingInTypeLambdaError e = - Strings.cat [ - "type variable shadowing in type lambda: ", - (Core.unName (ErrorCore.typeVariableShadowingInTypeLambdaErrorName e))] - --- | Show an undefined field error as a string -undefinedFieldError :: ErrorCore.UndefinedFieldError -> String -undefinedFieldError e = - - let fname = ErrorCore.undefinedFieldErrorFieldName e - tname = ErrorCore.undefinedFieldErrorTypeName e - in (Strings.cat [ - "no such field \"", - (Core.unName fname), - "\" in type \"", - (Core.unName tname), - "\""]) - --- | Show an undefined term variable error as a string -undefinedTermVariableError :: ErrorCore.UndefinedTermVariableError -> String -undefinedTermVariableError e = - Strings.cat [ - "undefined term variable: ", - (Core.unName (ErrorCore.undefinedTermVariableErrorName e))] - --- | Show an undefined type variable error as a string -undefinedTypeVariableError :: ErrorCore.UndefinedTypeVariableError -> String -undefinedTypeVariableError e = - Strings.cat [ - "undefined type variable: ", - (Core.unName (ErrorCore.undefinedTypeVariableErrorName e))] - --- | Show an undefined type variable in binding type error as a string -undefinedTypeVariableInBindingTypeError :: ErrorCore.UndefinedTypeVariableInBindingTypeError -> String -undefinedTypeVariableInBindingTypeError e = - Strings.cat [ - "undefined type variable in binding type: ", - (Core.unName (ErrorCore.undefinedTypeVariableInBindingTypeErrorName e))] - --- | Show an undefined type variable in lambda domain error as a string -undefinedTypeVariableInLambdaDomainError :: ErrorCore.UndefinedTypeVariableInLambdaDomainError -> String -undefinedTypeVariableInLambdaDomainError e = - Strings.cat [ - "undefined type variable in lambda domain: ", - (Core.unName (ErrorCore.undefinedTypeVariableInLambdaDomainErrorName e))] - --- | Show an undefined type variable in type application error as a string -undefinedTypeVariableInTypeApplicationError :: ErrorCore.UndefinedTypeVariableInTypeApplicationError -> String -undefinedTypeVariableInTypeApplicationError e = - Strings.cat [ - "undefined type variable in type application: ", - (Core.unName (ErrorCore.undefinedTypeVariableInTypeApplicationErrorName e))] - --- | Show an unexpected term variant error as a string -unexpectedTermVariantError :: ErrorCore.UnexpectedTermVariantError -> String -unexpectedTermVariantError e = - - let expected = ErrorCore.unexpectedTermVariantErrorExpectedVariant e - actual = ErrorCore.unexpectedTermVariantErrorActualTerm e - in (Strings.cat [ - "expected ", - (ShowVariants.termVariant expected), - " term but found ", - (ShowCore.term actual)]) - --- | Show an unexpected type variant error as a string -unexpectedTypeVariantError :: ErrorCore.UnexpectedTypeVariantError -> String -unexpectedTypeVariantError e = - - let expected = ErrorCore.unexpectedTypeVariantErrorExpectedVariant e - actual = ErrorCore.unexpectedTypeVariantErrorActualType e - in (Strings.cat [ - "expected ", - (ShowVariants.typeVariant expected), - " type but found ", - (ShowCore.type_ actual)]) - --- | Show an unknown primitive name error as a string -unknownPrimitiveNameError :: ErrorCore.UnknownPrimitiveNameError -> String -unknownPrimitiveNameError e = - Strings.cat [ - "unknown primitive: ", - (Core.unName (ErrorCore.unknownPrimitiveNameErrorName e))] - --- | Show an unnecessary identity application error as a string -unnecessaryIdentityApplicationError :: t0 -> String -unnecessaryIdentityApplicationError e = "unnecessary application of identity lambda" - --- | Show an untyped term variable error as a string -untypedTermVariableError :: ErrorCore.UntypedTermVariableError -> String -untypedTermVariableError e = - Strings.cat [ - "untyped term variable: ", - (Core.unName (ErrorCore.untypedTermVariableErrorName e))] - --- | Show a void in non-bottom position error as a string -voidInNonBottomPositionError :: t0 -> String -voidInNonBottomPositionError e = "TypeVoid in a position where no value can be constructed" diff --git a/src/main/haskell/Hydra/Show/Error/Packaging.hs b/src/main/haskell/Hydra/Show/Error/Packaging.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Error/Packaging.hs +++ /dev/null @@ -1,155 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.error.packaging types - -module Hydra.Show.Error.Packaging where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Util as ShowUtil -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a conflicting module namespace error as a string -conflictingModuleNameError :: ErrorPackaging.ConflictingModuleNameError -> String -conflictingModuleNameError e = - Strings.cat [ - "module namespaces conflict when mapped to target language path: ", - (Packaging.unModuleName (ErrorPackaging.conflictingModuleNameErrorFirst e)), - " vs ", - (Packaging.unModuleName (ErrorPackaging.conflictingModuleNameErrorSecond e))] - --- | Show a conflicting variant name error as a string -conflictingVariantNameError :: ErrorPackaging.ConflictingVariantNameError -> String -conflictingVariantNameError e = - Strings.cat [ - "in module ", - (Packaging.unModuleName (ErrorPackaging.conflictingVariantNameErrorModuleName e)), - ": variant ", - (Core.unName (ErrorPackaging.conflictingVariantNameErrorVariantName e)), - " of type ", - (Core.unName (ErrorPackaging.conflictingVariantNameErrorTypeName e)), - " produces constructor name ", - (Core.unName (ErrorPackaging.conflictingVariantNameErrorConflictingName e)), - " which conflicts with another type definition"] - --- | Show a definition-not-in-module-namespace error as a string -definitionNotInModuleNameError :: ErrorPackaging.DefinitionNotInModuleNameError -> String -definitionNotInModuleNameError e = - Strings.cat [ - "definition ", - (Core.unName (ErrorPackaging.definitionNotInModuleNameErrorName e)), - " is not in module namespace ", - (Packaging.unModuleName (ErrorPackaging.definitionNotInModuleNameErrorModuleName e))] - --- | Show a definitions-out-of-order error as a string -definitionsOutOfOrderError :: ErrorPackaging.DefinitionsOutOfOrderError -> String -definitionsOutOfOrderError e = - Strings.cat [ - "in module ", - (Packaging.unModuleName (ErrorPackaging.definitionsOutOfOrderErrorModuleName e)), - ": definitions out of order: ", - (Core.unName (ErrorPackaging.definitionsOutOfOrderErrorPrecedingName e)), - " precedes ", - (Core.unName (ErrorPackaging.definitionsOutOfOrderErrorFollowingName e))] - --- | Show a duplicate definition name error as a string -duplicateDefinitionNameError :: ErrorPackaging.DuplicateDefinitionNameError -> String -duplicateDefinitionNameError e = - Strings.cat [ - "in module ", - (Packaging.unModuleName (ErrorPackaging.duplicateDefinitionNameErrorModuleName e)), - ": duplicate definition name ", - (Core.unName (ErrorPackaging.duplicateDefinitionNameErrorName e))] - --- | Show a duplicate module namespace error as a string -duplicateModuleNameError :: ErrorPackaging.DuplicateModuleNameError -> String -duplicateModuleNameError e = - Strings.cat [ - "duplicate module namespace ", - (Packaging.unModuleName (ErrorPackaging.duplicateModuleNameErrorModuleName e))] - --- | Show an invalid definition name error as a string -invalidDefinitionNameError :: ErrorPackaging.InvalidDefinitionNameError -> String -invalidDefinitionNameError e = - Strings.cat [ - "in module ", - (Packaging.unModuleName (ErrorPackaging.invalidDefinitionNameErrorModuleName e)), - ": definition ", - (Core.unName (ErrorPackaging.invalidDefinitionNameErrorName e)), - " does not match expected ", - (ShowUtil.caseConvention (ErrorPackaging.invalidDefinitionNameErrorExpectedConvention e))] - --- | Show an invalid module error as a string -invalidModuleError :: ErrorPackaging.InvalidModuleError -> String -invalidModuleError e = - Strings.cat2 "invalid module: " (case e of - ErrorPackaging.InvalidModuleErrorConflictingVariantName v0 -> conflictingVariantNameError v0 - ErrorPackaging.InvalidModuleErrorDefinitionNotInModuleName v0 -> definitionNotInModuleNameError v0 - ErrorPackaging.InvalidModuleErrorDefinitionsOutOfOrder v0 -> definitionsOutOfOrderError v0 - ErrorPackaging.InvalidModuleErrorDuplicateDefinitionName v0 -> duplicateDefinitionNameError v0 - ErrorPackaging.InvalidModuleErrorInvalidDefinitionName v0 -> invalidDefinitionNameError v0 - ErrorPackaging.InvalidModuleErrorInvalidModuleNameConvention v0 -> invalidModuleNameConventionError v0 - ErrorPackaging.InvalidModuleErrorMissingDocumentation v0 -> missingDocumentationError v0) - --- | Show an invalid namespace convention error as a string -invalidModuleNameConventionError :: ErrorPackaging.InvalidModuleNameConventionError -> String -invalidModuleNameConventionError e = - Strings.cat [ - "namespace ", - (Packaging.unModuleName (ErrorPackaging.invalidModuleNameConventionErrorModuleName e)), - " does not match the dotted-camelCase naming convention"] - --- | Show an invalid package error as a string -invalidPackageError :: ErrorPackaging.InvalidPackageError -> String -invalidPackageError e = - Strings.cat2 "invalid package: " (case e of - ErrorPackaging.InvalidPackageErrorConflictingModuleName v0 -> conflictingModuleNameError v0 - ErrorPackaging.InvalidPackageErrorDuplicateModuleName v0 -> duplicateModuleNameError v0 - ErrorPackaging.InvalidPackageErrorInvalidModule v0 -> invalidModuleError v0 - ErrorPackaging.InvalidPackageErrorInvalidPackageName v0 -> invalidPackageNameError v0) - --- | Show an invalid package name error as a string -invalidPackageNameError :: ErrorPackaging.InvalidPackageNameError -> String -invalidPackageNameError e = - Strings.cat [ - "package name ", - (Packaging.unPackageName (ErrorPackaging.invalidPackageNameErrorPackageName e)), - " does not match the hyphen-separated lowercase naming convention"] - --- | Show a missing documentation error as a string -missingDocumentationError :: ErrorPackaging.MissingDocumentationError -> String -missingDocumentationError e = - Strings.cat [ - "in module ", - (Packaging.unModuleName (ErrorPackaging.missingDocumentationErrorModuleName e)), - ": definition ", - (Core.unName (ErrorPackaging.missingDocumentationErrorName e)), - " lacks a description annotation"] diff --git a/src/main/haskell/Hydra/Show/Errors.hs b/src/main/haskell/Hydra/Show/Errors.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Errors.hs +++ /dev/null @@ -1,214 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.error types - -module Hydra.Show.Errors where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -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.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals -import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.Show.Error.Core as ShowErrorCore -import qualified Hydra.Show.Typing as ShowTyping -import qualified Hydra.Show.Variants as ShowVariants -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a checking error as a string -checkingError :: Checking.CheckingError -> String -checkingError ce = - case ce of - Checking.CheckingErrorIncorrectUnification v0 -> incorrectUnificationError v0 - Checking.CheckingErrorNotAForallType v0 -> notAForallTypeError v0 - Checking.CheckingErrorNotAFunctionType v0 -> notAFunctionTypeError v0 - Checking.CheckingErrorTypeArityMismatch v0 -> typeArityMismatchError v0 - Checking.CheckingErrorTypeMismatch v0 -> typeMismatchError v0 - Checking.CheckingErrorUnboundTypeVariables v0 -> unboundTypeVariablesError v0 - Checking.CheckingErrorUnequalTypes v0 -> unequalTypesError v0 - Checking.CheckingErrorUnsupportedTermVariant v0 -> unsupportedTermVariantError v0 - Checking.CheckingErrorUntypedLambda v0 -> untypedLambdaError v0 - Checking.CheckingErrorUntypedLetBinding v0 -> untypedLetBindingError v0 - --- | Show a decoding error as a string -decodingError :: Errors.DecodingError -> String -decodingError de = Strings.cat2 "decoding error: " (Errors.unDecodingError de) - --- | Show an error as a string -error :: Errors.Error -> String -error e = - case e of - Errors.ErrorChecking v0 -> checkingError v0 - Errors.ErrorDecoding v0 -> decodingError v0 - Errors.ErrorDuplicateBinding v0 -> ShowErrorCore.duplicateBindingError v0 - Errors.ErrorDuplicateField v0 -> ShowErrorCore.duplicateFieldError v0 - Errors.ErrorExtraction _ -> "extraction error" - Errors.ErrorInference _ -> "inference error" - Errors.ErrorOther v0 -> otherError v0 - Errors.ErrorResolution v0 -> resolutionError v0 - Errors.ErrorUndefinedField v0 -> ShowErrorCore.undefinedFieldError v0 - Errors.ErrorUndefinedTermVariable v0 -> ShowErrorCore.undefinedTermVariableError v0 - Errors.ErrorUntypedTermVariable v0 -> ShowErrorCore.untypedTermVariableError v0 - Errors.ErrorUnexpectedTermVariant v0 -> ShowErrorCore.unexpectedTermVariantError v0 - Errors.ErrorUnexpectedTypeVariant v0 -> ShowErrorCore.unexpectedTypeVariantError v0 - Errors.ErrorUnification v0 -> unificationError v0 - --- | Show an incorrect unification error as a string -incorrectUnificationError :: Checking.IncorrectUnificationError -> String -incorrectUnificationError e = - - let subst = Checking.incorrectUnificationErrorSubstitution e - in (Strings.cat2 "incorrect unification: " (ShowTyping.typeSubst subst)) - --- | Show a not-a-forall-type error as a string -notAForallTypeError :: Checking.NotAForallTypeError -> String -notAForallTypeError e = - - let typ = Checking.notAForallTypeErrorType e - args = Checking.notAForallTypeErrorTypeArguments e - in (Strings.cat [ - "not a forall type: ", - (ShowCore.type_ typ), - ". Trying to apply ", - (Literals.showInt32 (Lists.length args)), - " type argument(s): ", - (Formatting.showList ShowCore.type_ args)]) - --- | Show a not-a-function-type error as a string -notAFunctionTypeError :: Checking.NotAFunctionTypeError -> String -notAFunctionTypeError e = - - let typ = Checking.notAFunctionTypeErrorType e - in (Strings.cat2 "not a function type: " (ShowCore.type_ typ)) - --- | Show an other error as a string -otherError :: Errors.OtherError -> String -otherError oe = Errors.unOtherError oe - --- | Show a resolution error as a string, including the offending name or shape -resolutionError :: Errors.ResolutionError -> String -resolutionError re = - case re of - Errors.ResolutionErrorNoSuchBinding v0 -> Strings.cat2 "no such binding: " (Core.unName (Errors.noSuchBindingErrorName v0)) - Errors.ResolutionErrorNoSuchPrimitive v0 -> Strings.cat2 "no such primitive: " (Core.unName (Errors.noSuchPrimitiveErrorName v0)) - Errors.ResolutionErrorNoMatchingField v0 -> Strings.cat2 "no matching field: " (Core.unName (Errors.noMatchingFieldErrorFieldName v0)) - Errors.ResolutionErrorOther v0 -> Strings.cat2 "resolution error: " (Errors.unOtherResolutionError v0) - Errors.ResolutionErrorUnexpectedShape v0 -> Strings.cat [ - "unexpected shape: expected ", - (Errors.unexpectedShapeErrorExpected v0), - " but got ", - (Errors.unexpectedShapeErrorActual v0)] - --- | Show a type arity mismatch error as a string -typeArityMismatchError :: Checking.TypeArityMismatchError -> String -typeArityMismatchError e = - - let typ = Checking.typeArityMismatchErrorType e - expected = Checking.typeArityMismatchErrorExpectedArity e - actual = Checking.typeArityMismatchErrorActualArity e - args = Checking.typeArityMismatchErrorTypeArguments e - in (Strings.cat [ - "type ", - (ShowCore.type_ typ), - " applied to the wrong number of type arguments (expected ", - (Literals.showInt32 expected), - ", got ", - (Literals.showInt32 actual), - "): ", - (Formatting.showList ShowCore.type_ args)]) - --- | Show a type mismatch error as a string -typeMismatchError :: Checking.TypeMismatchError -> String -typeMismatchError e = - - let expected = Checking.typeMismatchErrorExpectedType e - actual = Checking.typeMismatchErrorActualType e - in (Strings.cat [ - "type mismatch: expected ", - (ShowCore.type_ expected), - " but found ", - (ShowCore.type_ actual)]) - --- | Show an unbound type variables error as a string -unboundTypeVariablesError :: Checking.UnboundTypeVariablesError -> String -unboundTypeVariablesError e = - - let vars = Checking.unboundTypeVariablesErrorVariables e - typ = Checking.unboundTypeVariablesErrorType e - in (Strings.cat [ - "unbound type variables: {", - (Strings.intercalate ", " (Lists.map Core.unName (Sets.toList vars))), - "} in type ", - (ShowCore.type_ typ)]) - --- | Show an unequal types error as a string -unequalTypesError :: Checking.UnequalTypesError -> String -unequalTypesError e = - - let types = Checking.unequalTypesErrorTypes e - desc = Checking.unequalTypesErrorDescription e - in (Strings.cat [ - "unequal types ", - (Formatting.showList ShowCore.type_ types), - " in ", - desc]) - --- | Show a unification error as a string -unificationError :: Errors.UnificationError -> String -unificationError e = - - let lt = Errors.unificationErrorLeftType e - rt = Errors.unificationErrorRightType e - msg = Errors.unificationErrorMessage e - in (Strings.cat [ - "unification error: cannot unify ", - (ShowCore.type_ lt), - " with ", - (ShowCore.type_ rt), - ": ", - msg]) - --- | Show an unsupported term variant error as a string -unsupportedTermVariantError :: Checking.UnsupportedTermVariantError -> String -unsupportedTermVariantError e = - Strings.cat2 "unsupported term variant: " (ShowVariants.termVariant (Checking.unsupportedTermVariantErrorTermVariant e)) - --- | Show an untyped lambda error as a string -untypedLambdaError :: t0 -> String -untypedLambdaError _ = "untyped lambda" - --- | Show an untyped let binding error as a string -untypedLetBindingError :: Checking.UntypedLetBindingError -> String -untypedLetBindingError e = - - let b = Checking.untypedLetBindingErrorBinding e - in (Strings.cat2 "untyped let binding: " (ShowCore.binding b)) diff --git a/src/main/haskell/Hydra/Show/Graph.hs b/src/main/haskell/Hydra/Show/Graph.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Graph.hs +++ /dev/null @@ -1,49 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.graph types - -module Hydra.Show.Graph where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a list of bindings as a string -graph :: [Core.Binding] -> String -graph elements = - - let elementStrs = Lists.map ShowCore.binding elements - in (Strings.cat [ - "{", - (Strings.intercalate ", " elementStrs), - "}"]) diff --git a/src/main/haskell/Hydra/Show/Paths.hs b/src/main/haskell/Hydra/Show/Paths.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Paths.hs +++ /dev/null @@ -1,140 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | Utilities for working with subterm steps and paths. - -module Hydra.Show.Paths where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps -import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Names as Names -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Rewriting as Rewriting -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci -import qualified Data.Map as M - --- | Convert a subterm step to a string representation -subtermStep :: Paths.SubtermStep -> Maybe String -subtermStep step = - - let idx = \i -> Nothing - idxSuff = \suffix -> \i -> Optionals.map (\s -> Strings.cat2 s suffix) (idx i) - in case step of - Paths.SubtermStepAnnotatedBody -> Nothing - Paths.SubtermStepApplicationFunction -> Just "fun" - Paths.SubtermStepApplicationArgument -> Just "arg" - Paths.SubtermStepLambdaBody -> Just "body" - Paths.SubtermStepUnionCasesDefault -> Just "default" - Paths.SubtermStepUnionCasesBranch v0 -> Just (Strings.cat2 "." (Core.unName v0)) - Paths.SubtermStepLetBody -> Just "in" - Paths.SubtermStepLetBinding v0 -> Just (Strings.cat2 (Core.unName v0) "=") - Paths.SubtermStepListElement v0 -> idx v0 - Paths.SubtermStepMapKey v0 -> idxSuff ".key" v0 - Paths.SubtermStepMapValue v0 -> idxSuff ".value" v0 - Paths.SubtermStepOptionalTerm -> Just "given" - Paths.SubtermStepProductTerm v0 -> idx v0 - Paths.SubtermStepRecordField v0 -> Just (Strings.cat2 "." (Core.unName v0)) - Paths.SubtermStepSetElement v0 -> idx v0 - Paths.SubtermStepSumTerm -> Nothing - Paths.SubtermStepTypeLambdaBody -> Nothing - Paths.SubtermStepTypeApplicationTerm -> Nothing - Paths.SubtermStepInjectionTerm -> Nothing - Paths.SubtermStepWrappedTerm -> Nothing - --- | Build a subterm graph from a term -termToSubtermGraph :: M.Map Packaging.ModuleName String -> Core.Term -> Paths.SubtermGraph -termToSubtermGraph namespaces term = - - let dontCareStep = Paths.SubtermStepAnnotatedBody - helper = - \ids -> \mroot -> \path -> \state -> \stepTerm -> - let step = Pairs.first stepTerm - currentTerm = Pairs.second stepTerm - nodesEdges = Pairs.first state - visited = Pairs.second state - nodes = Pairs.first nodesEdges - edges = Pairs.second nodesEdges - nextPath = Lists.cons step path - in case currentTerm of - Core.TermLet v0 -> - let bindings = Core.letBindings v0 - env = Core.letBody v0 - bindingNames = Lists.map Core.bindingName bindings - addBindingName = - \nodesVisitedIds -> \name -> - let currentNodesVisited = Pairs.first nodesVisitedIds - currentIds = Pairs.second nodesVisitedIds - currentNodes = Pairs.first currentNodesVisited - currentVisited = Pairs.second currentNodesVisited - rawLabel = Names.compactName namespaces name - uniqueLabel = Names.chooseUniqueLabel currentVisited rawLabel - node = - Paths.SubtermNode { - Paths.subtermNodeName = name, - Paths.subtermNodeLabel = rawLabel, - Paths.subtermNodeId = uniqueLabel} - newVisited = Sets.insert uniqueLabel currentVisited - newNodes = Lists.cons node currentNodes - newIds = Maps.insert name node currentIds - in ((newNodes, newVisited), newIds) - nodesVisitedIds1 = Lists.foldl addBindingName (([], visited), ids) bindingNames - nodes1 = Pairs.first (Pairs.first nodesVisitedIds1) - visited1 = Pairs.second (Pairs.first nodesVisitedIds1) - ids1 = Pairs.second nodesVisitedIds1 - addBindingTerm = - \currentState -> \nodeBinding -> - let root = Pairs.first nodeBinding - binding = Pairs.second nodeBinding - term1 = Core.bindingTerm binding - in (helper ids1 (Just root) [] currentState (dontCareStep, term1)) - nodeBindingPairs = Lists.zip nodes1 bindings - stateAfterBindings = Lists.foldl addBindingTerm ((Lists.concat2 nodes1 nodes, edges), visited1) nodeBindingPairs - in (helper ids1 mroot nextPath stateAfterBindings (Paths.SubtermStepLetBody, env)) - Core.TermVariable v0 -> Optionals.cases mroot state (\root -> Optionals.cases (Maps.lookup v0 ids) state (\node -> - let edge = - Paths.SubtermEdge { - Paths.subtermEdgeSource = root, - Paths.subtermEdgePath = (Paths.SubtermPath (Lists.reverse nextPath)), - Paths.subtermEdgeTarget = node} - newEdges = Lists.cons edge edges - in ((nodes, newEdges), visited))) - _ -> Lists.foldl (helper ids mroot nextPath) state (Rewriting.subtermsWithSteps currentTerm) - initialState = (([], []), Sets.empty) - result = helper Maps.empty Nothing [] initialState (dontCareStep, term) - finalNodesEdges = Pairs.first result - finalNodes = Pairs.first finalNodesEdges - finalEdges = Pairs.second finalNodesEdges - in Paths.SubtermGraph { - Paths.subtermGraphNodes = finalNodes, - Paths.subtermGraphEdges = finalEdges} diff --git a/src/main/haskell/Hydra/Show/Typing.hs b/src/main/haskell/Hydra/Show/Typing.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Typing.hs +++ /dev/null @@ -1,72 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.typing types - -module Hydra.Show.Typing where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists -import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps -import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a type constraint as a string -typeConstraint :: Typing.TypeConstraint -> String -typeConstraint tc = - - let ltyp = Typing.typeConstraintLeft tc - rtyp = Typing.typeConstraintRight tc - in (Strings.cat [ - ShowCore.type_ ltyp, - "\8801", - (ShowCore.type_ rtyp)]) - --- | Show a type substitution as a string -typeSubst :: Typing.TypeSubst -> String -typeSubst ts = - - let subst = Typing.unTypeSubst ts - pairs = Maps.toList subst - showPair = - \pair -> - let name = Core.unName (Pairs.first pair) - typ = Pairs.second pair - in (Strings.cat [ - name, - "\8614", - (ShowCore.type_ typ)]) - pairStrs = Lists.map showPair pairs - in (Strings.cat [ - "{", - (Strings.intercalate "," pairStrs), - "}"]) diff --git a/src/main/haskell/Hydra/Show/Util.hs b/src/main/haskell/Hydra/Show/Util.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Util.hs +++ /dev/null @@ -1,53 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.util types - -module Hydra.Show.Util where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a case convention as a string -caseConvention :: Util.CaseConvention -> String -caseConvention c = - case c of - Util.CaseConventionLowerSnake -> "lower_snake_case" - Util.CaseConventionUpperSnake -> "UPPER_SNAKE_CASE" - Util.CaseConventionCamel -> "camelCase" - Util.CaseConventionPascal -> "PascalCase" - --- | Show a comparison result as a string -comparison :: Util.Comparison -> String -comparison c = - case c of - Util.ComparisonLessThan -> "lessThan" - Util.ComparisonEqualTo -> "equalTo" - Util.ComparisonGreaterThan -> "greaterThan" diff --git a/src/main/haskell/Hydra/Show/Variants.hs b/src/main/haskell/Hydra/Show/Variants.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Show/Variants.hs +++ /dev/null @@ -1,85 +0,0 @@ --- Note: this is an automatically generated file. Do not edit. - --- | String representations of hydra.variants types - -module Hydra.Show.Variants where - -import qualified Hydra.Ast as Ast -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Docs as Docs -import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Error.Core as ErrorCore -import qualified Hydra.Error.File as ErrorFile -import qualified Hydra.Error.Packaging as ErrorPackaging -import qualified Hydra.Error.System as ErrorSystem -import qualified Hydra.Errors as Errors -import qualified Hydra.File as File -import qualified Hydra.Graph as Graph -import qualified Hydra.Json.Model as Model -import qualified Hydra.Packaging as Packaging -import qualified Hydra.Parsing as Parsing -import qualified Hydra.Paths as Paths -import qualified Hydra.Query as Query -import qualified Hydra.Relational as Relational -import qualified Hydra.System as System -import qualified Hydra.Tabular as Tabular -import qualified Hydra.Testing as Testing -import qualified Hydra.Time as Time -import qualified Hydra.Topology as Topology -import qualified Hydra.Typed as Typed -import qualified Hydra.Typing as Typing -import qualified Hydra.Util as Util -import qualified Hydra.Validation as Validation -import qualified Hydra.Variants as Variants -import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) -import qualified Data.Scientific as Sci - --- | Show a term variant as a string -termVariant :: Variants.TermVariant -> String -termVariant x = - case x of - Variants.TermVariantAnnotated -> "annotated" - Variants.TermVariantApplication -> "application" - Variants.TermVariantCases -> "cases" - Variants.TermVariantEither -> "either" - Variants.TermVariantLambda -> "lambda" - Variants.TermVariantLet -> "let" - Variants.TermVariantList -> "list" - Variants.TermVariantLiteral -> "literal" - Variants.TermVariantMap -> "map" - Variants.TermVariantOptional -> "optional" - Variants.TermVariantPair -> "pair" - Variants.TermVariantProject -> "project" - Variants.TermVariantRecord -> "record" - Variants.TermVariantSet -> "set" - Variants.TermVariantTypeLambda -> "typeLambda" - Variants.TermVariantTypeApplication -> "typeApplication" - Variants.TermVariantInject -> "inject" - Variants.TermVariantUnit -> "unit" - Variants.TermVariantUnwrap -> "unwrap" - Variants.TermVariantVariable -> "variable" - Variants.TermVariantWrap -> "wrap" - --- | Show a type variant as a string -typeVariant :: Variants.TypeVariant -> String -typeVariant x = - case x of - Variants.TypeVariantAnnotated -> "annotated" - Variants.TypeVariantApplication -> "application" - Variants.TypeVariantEffect -> "effect" - Variants.TypeVariantEither -> "either" - Variants.TypeVariantForall -> "forall" - Variants.TypeVariantFunction -> "function" - Variants.TypeVariantList -> "list" - Variants.TypeVariantLiteral -> "literal" - Variants.TypeVariantMap -> "map" - Variants.TypeVariantOptional -> "optional" - Variants.TypeVariantPair -> "pair" - Variants.TypeVariantRecord -> "record" - Variants.TypeVariantSet -> "set" - Variants.TypeVariantUnion -> "union" - Variants.TypeVariantUnit -> "unit" - Variants.TypeVariantVariable -> "variable" - Variants.TypeVariantVoid -> "void" - Variants.TypeVariantWrap -> "wrap" diff --git a/src/main/haskell/Hydra/Sorting.hs b/src/main/haskell/Hydra/Sorting.hs --- a/src/main/haskell/Hydra/Sorting.hs +++ b/src/main/haskell/Hydra/Sorting.hs @@ -19,17 +19,20 @@ import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as Model import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Functions as Functions import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -52,14 +55,14 @@ Lists.foldl (\mp -> \p -> let k = Pairs.first p vs = Pairs.second p - existing = Optionals.cases (Maps.lookup k mp) [] Equality.identity + existing = Optionals.cases (Maps.lookup k mp) [] Functions.identity in (Maps.insert k (Lists.concat2 existing vs) mp)) Maps.empty pairs -- | Given a list of adjacency lists represented as (key, [key]) pairs, construct a graph along with a function mapping each vertex (an Int) back to its original key (Nothing for unknown vertices). adjacencyListsToGraph :: Ord t0 => ([(t0, [t0])] -> (M.Map Int [Int], (Int -> Maybe t0))) adjacencyListsToGraph edges0 = - let sortedEdges = Lists.sortOn Pairs.first edges0 + let sortedEdges = Lists.sortBy Pairs.first edges0 indexedEdges = Lists.zip (Math.range 0 (Lists.length sortedEdges)) sortedEdges keyToVertex = Maps.fromList (Lists.map (\vkNeighbors -> @@ -89,11 +92,11 @@ let sourceToTargetMapping = \els -> let mp = Maps.fromList (Lists.zip sourceOrd els) - in (Optionals.cat (Lists.map (\n -> Maps.lookup n mp) targetOrd)) + in (Optionals.givens (Lists.map (\n -> Maps.lookup n mp) targetOrd)) targetToSourceMapping = \els -> let mp = Maps.fromList (Lists.zip targetOrd els) - in (Optionals.cat (Lists.map (\n -> Maps.lookup n mp) sourceOrd)) + in (Optionals.givens (Lists.map (\n -> Maps.lookup n mp) sourceOrd)) in Topology.OrderingIsomorphism { Topology.orderingIsomorphismEncode = sourceToTargetMapping, Topology.orderingIsomorphismDecode = targetToSourceMapping} @@ -156,8 +159,8 @@ allNodes = Sets.toList (Sets.fromList (Lists.concat2 (Lists.map Pairs.first edges) (Lists.map Pairs.first nodeTags))) getTagsForNode = \node -> - let reachable = findReachableNodes (\n -> Sets.fromList (Optionals.cases (Maps.lookup n adjMap) [] Equality.identity)) node - in (Sets.unions (Lists.map (\n -> Optionals.cases (Maps.lookup n tagMap) Sets.empty Equality.identity) (Sets.toList reachable))) + let reachable = findReachableNodes (\n -> Sets.fromList (Optionals.cases (Maps.lookup n adjMap) [] Functions.identity)) node + in (Sets.unions (Lists.map (\n -> Optionals.cases (Maps.lookup n tagMap) Sets.empty Functions.identity) (Sets.toList reachable))) in (Lists.map (\n -> (n, (getTagsForNode n))) allNodes) -- | Visit a vertex and recursively explore its successors @@ -183,7 +186,7 @@ in Topology.TarjanState { Topology.tarjanStateCounter = (Topology.tarjanStateCounter s), Topology.tarjanStateIndices = (Topology.tarjanStateIndices s), - Topology.tarjanStateLowLinks = (Maps.insert v (Equality.min lowV1 idx_w) (Topology.tarjanStateLowLinks s)), + Topology.tarjanStateLowLinks = (Maps.insert v (Ordering.min lowV1 idx_w) (Topology.tarjanStateLowLinks s)), Topology.tarjanStateStack = (Topology.tarjanStateStack s), Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack s), Topology.tarjanStateSccs = (Topology.tarjanStateSccs s)} @@ -194,7 +197,7 @@ in Topology.TarjanState { Topology.tarjanStateCounter = (Topology.tarjanStateCounter stAfter), Topology.tarjanStateIndices = (Topology.tarjanStateIndices stAfter), - Topology.tarjanStateLowLinks = (Maps.insert v (Equality.min lowV2 low_w) (Topology.tarjanStateLowLinks stAfter)), + Topology.tarjanStateLowLinks = (Maps.insert v (Ordering.min lowV2 low_w) (Topology.tarjanStateLowLinks stAfter)), Topology.tarjanStateStack = (Topology.tarjanStateStack stAfter), Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack stAfter), Topology.tarjanStateSccs = (Topology.tarjanStateSccs stAfter)}) (Logic.ifElse (Sets.member w (Topology.tarjanStateOnStack st_)) (lowLink st_) st_)) @@ -227,7 +230,7 @@ topologicalSort pairs = let sccs = topologicalSortComponents pairs - isCycle = \scc -> Equality.gt (Lists.length scc) 1 + isCycle = \scc -> Ordering.gt (Lists.length scc) 1 withCycles = Lists.filter isCycle sccs in (Logic.ifElse (Lists.null withCycles) (Right (Lists.concat sccs)) (Left withCycles)) @@ -246,4 +249,4 @@ let nodesByKey = Maps.fromList (Lists.map (\n -> (getKey n, n)) nodes) pairs = Lists.map (\n -> (getKey n, (getAdj n))) nodes comps = topologicalSortComponents pairs - in (Lists.map (\c -> Optionals.cat (Lists.map (\k -> Maps.lookup k nodesByKey) c)) comps) + in (Lists.map (\c -> Optionals.givens (Lists.map (\k -> Maps.lookup k nodesByKey) c)) comps) diff --git a/src/main/haskell/Hydra/Strip.hs b/src/main/haskell/Hydra/Strip.hs --- a/src/main/haskell/Hydra/Strip.hs +++ b/src/main/haskell/Hydra/Strip.hs @@ -22,6 +22,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths 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.System as System diff --git a/src/main/haskell/Hydra/Substitution.hs b/src/main/haskell/Hydra/Substitution.hs --- a/src/main/haskell/Hydra/Substitution.hs +++ b/src/main/haskell/Hydra/Substitution.hs @@ -27,6 +27,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths 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.System as System @@ -78,7 +79,7 @@ \varName -> \metadata -> \acc -> Optionals.cases (Maps.lookup varName acc) (Maps.insert varName metadata acc) (\existing -> let merged = Core.TypeVariableConstraints { - Core.typeVariableConstraintsClasses = (Lists.nub (Lists.concat2 (Core.typeVariableConstraintsClasses existing) (Core.typeVariableConstraintsClasses metadata)))} + Core.typeVariableConstraintsClasses = (Lists.distinct (Lists.concat2 (Core.typeVariableConstraintsClasses existing) (Core.typeVariableConstraintsClasses metadata)))} in (Maps.insert varName merged acc)) in (Lists.foldl (\acc -> \pair -> let varName = Pairs.first pair diff --git a/src/main/haskell/Hydra/Templates.hs b/src/main/haskell/Hydra/Templates.hs --- a/src/main/haskell/Hydra/Templates.hs +++ b/src/main/haskell/Hydra/Templates.hs @@ -28,9 +28,10 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Core as ShowCore import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -113,7 +114,7 @@ e])))) Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 schema) (Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "bound type variable", - Errors.unexpectedShapeErrorActual = (Strings.cat2 "unbound variable " (Core.unName v0))})))) (inst v0) + Errors.unexpectedShapeErrorActual = (Strings.concat2 "unbound variable " (Core.unName v0))})))) (inst v0) Core.TypeWrap v0 -> Eithers.bind (inst tname v0) (\e -> Right (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = tname, Core.wrappedTermBody = e}))) diff --git a/src/main/haskell/Hydra/Test/Transform.hs b/src/main/haskell/Hydra/Test/Transform.hs --- a/src/main/haskell/Hydra/Test/Transform.hs +++ b/src/main/haskell/Hydra/Test/Transform.hs @@ -28,6 +28,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Sorting as Sorting import qualified Hydra.System as System @@ -45,7 +46,7 @@ -- | Add generation namespace prefix addGenerationPrefix :: Packaging.ModuleName -> Packaging.ModuleName -addGenerationPrefix ns_ = Packaging.ModuleName (Strings.cat2 "generation." (Packaging.unModuleName ns_)) +addGenerationPrefix ns_ = Packaging.ModuleName (Strings.concat2 "generation." (Packaging.unModuleName ns_)) -- | Build a Term representing a convertCase function call buildConvertCaseCall :: Util.CaseConvention -> Util.CaseConvention -> String -> Core.Term @@ -133,8 +134,8 @@ desc = Testing.testGroupDescription tg subgroups = Testing.testGroupSubgroups tg cases_ = Testing.testGroupCases tg - transformedCases = Optionals.cat (Lists.map (\tc -> transformTestCase tc) cases_) - transformedSubgroups = Optionals.cat (Lists.map (\sg -> transformToCompiledTests sg) subgroups) + transformedCases = Optionals.givens (Lists.map (\tc -> transformTestCase tc) cases_) + transformedSubgroups = Optionals.givens (Lists.map (\sg -> transformToCompiledTests sg) subgroups) in (Logic.ifElse (Logic.and (Lists.null transformedCases) (Lists.null transformedSubgroups)) Nothing (Just (Testing.TestGroup { Testing.testGroupName = name_, Testing.testGroupDescription = desc, diff --git a/src/main/haskell/Hydra/Test/Utils.hs b/src/main/haskell/Hydra/Test/Utils.hs --- a/src/main/haskell/Hydra/Test/Utils.hs +++ b/src/main/haskell/Hydra/Test/Utils.hs @@ -23,9 +23,10 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Errors as PrintErrors import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational -import qualified Hydra.Show.Errors as ShowErrors import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -42,7 +43,7 @@ -- | Run type inference on a single term inferTerm :: Graph.Graph -> Core.Term -> Either String Core.Term inferTerm g term = - Eithers.bimap (\e -> ShowErrors.error e) (\x -> Typing.inferenceResultTerm x) (Inference.inferInGraphContext Lexical.emptyInferenceContext g term) + Eithers.bimap (\e -> PrintErrors.error e) (\x -> Typing.inferenceResultTerm x) (Inference.inferInGraphContext Lexical.emptyInferenceContext g term) -- | Run type inference on the terms in a test case inferTestCase :: t0 -> Testing.TestCaseWithMetadata -> Either t1 Testing.TestCaseWithMetadata diff --git a/src/main/haskell/Hydra/Typed.hs b/src/main/haskell/Hydra/Typed.hs --- a/src/main/haskell/Hydra/Typed.hs +++ b/src/main/haskell/Hydra/Typed.hs @@ -23,6 +23,14 @@ _TypedBinding_term = Core.Name "term" +-- | An association of a name with a phantom type +newtype TypedName a = + TypedName { + unTypedName :: Core.Name} + deriving (Eq, Ord, Read, Show) + +_TypedName = Core.Name "hydra.typed.TypedName" + -- | An association of a term with a phantom type newtype TypedTerm a = TypedTerm { diff --git a/src/main/haskell/Hydra/Unification.hs b/src/main/haskell/Hydra/Unification.hs --- a/src/main/haskell/Hydra/Unification.hs +++ b/src/main/haskell/Hydra/Unification.hs @@ -28,10 +28,11 @@ import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths +import qualified Hydra.Print.Core as PrintCore 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.Show.Core as ShowCore import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System @@ -58,12 +59,12 @@ \l -> \r -> Typing.TypeConstraint { Typing.typeConstraintLeft = l, Typing.typeConstraintRight = r, - Typing.typeConstraintComment = (Strings.cat2 "join types; " comment)} + Typing.typeConstraintComment = (Strings.concat2 "join types; " comment)} cannotUnify = Left (Errors.UnificationError { Errors.unificationErrorLeftType = sleft, Errors.unificationErrorRightType = sright, - Errors.unificationErrorMessage = (Strings.cat2 (Strings.cat2 (Strings.cat2 "cannot unify " (ShowCore.type_ sleft)) " with ") (ShowCore.type_ sright))}) + Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 "cannot unify " (PrintCore.type_ sleft)) " with ") (PrintCore.type_ sright))}) assertEqual = Logic.ifElse (Equality.equal sleft sright) (Right []) cannotUnify joinList = \lefts -> \rights -> Logic.ifElse (Equality.equal (Lists.length lefts) (Lists.length rights)) (Right (Lists.zipWith joinOne lefts rights)) cannotUnify @@ -153,7 +154,7 @@ \v -> \t -> Logic.ifElse (variableOccursInType v t) (Left (Errors.UnificationError { Errors.unificationErrorLeftType = sleft, Errors.unificationErrorRightType = sright, - Errors.unificationErrorMessage = (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 "Variable " (Core.unName v)) " appears free in type ") (ShowCore.type_ t)) " (") comment) ")")})) (bind v t) + Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Variable " (Core.unName v)) " appears free in type ") (PrintCore.type_ t)) " (") comment) ")")})) (bind v t) noVars = let withConstraints = \constraints2 -> unifyTypeConstraints cx schemaTypes (Lists.concat2 constraints2 rest) @@ -167,7 +168,7 @@ Core.TypeVariable v1 -> Logic.ifElse (Equality.equal (Core.unName v0) (Core.unName v1)) (unifyTypeConstraints cx schemaTypes rest) (Logic.ifElse (Optionals.isGiven (Maps.lookup v0 schemaTypes)) (Logic.ifElse (Optionals.isGiven (Maps.lookup v1 schemaTypes)) (Left (Errors.UnificationError { Errors.unificationErrorLeftType = sleft, Errors.unificationErrorRightType = sright, - Errors.unificationErrorMessage = (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 "Attempted to unify schema names " (Core.unName v0)) " and ") (Core.unName v1)) " (") comment) ")")})) (bind v1 sleft)) (bind v0 sright)) + Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Attempted to unify schema names " (Core.unName v0)) " and ") (Core.unName v1)) " (") comment) ")")})) (bind v1 sleft)) (bind v0 sright)) _ -> tryBinding v0 sright _ -> dflt in (Optionals.cases (Lists.uncons constraints) (Right Substitution.idTypeSubst) (\uc -> withConstraint (Pairs.first uc) (Pairs.second uc))) diff --git a/src/main/haskell/Hydra/Validate/Core.hs b/src/main/haskell/Hydra/Validate/Core.hs --- a/src/main/haskell/Hydra/Validate/Core.hs +++ b/src/main/haskell/Hydra/Validate/Core.hs @@ -23,6 +23,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Packaging as Packaging @@ -30,8 +31,11 @@ import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query import qualified Hydra.Reflect as Reflect +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.Rewriting as Rewriting +import qualified Hydra.Scoping as Scoping +import qualified Hydra.Strip as Strip import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular import qualified Hydra.Testing as Testing @@ -55,9 +59,9 @@ payload = Pairs.second rp errs = Validation.validationResultErrors acc wrns = Validation.validationResultWarnings acc - in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { + in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)), - Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { + Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { Validation.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -69,9 +73,9 @@ payload = Pairs.second rp errs = Validation.validationResultErrors acc wrns = Validation.validationResultWarnings acc - in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { + in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)), - Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { + Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { Validation.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -218,13 +222,29 @@ let tname = Core.caseStatementTypeName v0 csDefault = Core.caseStatementDefault v0 csCases = Core.caseStatementCases v0 + altNames = Sets.fromList (Lists.map Core.caseAlternativeName csCases) + unionFields = resolveUnionFields cx tname in (firstFinding [ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError { ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing, (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyCaseStatement")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyCaseStatement", f)) (Logic.ifElse (Logic.and (Lists.null csCases) (Optionals.isNone csDefault)) (Just (ErrorCore.InvalidTermErrorEmptyCaseStatement (ErrorCore.EmptyCaseStatementError { ErrorCore.emptyCaseStatementErrorLocation = path, ErrorCore.emptyCaseStatementErrorTypeName = tname}))) Nothing)) Nothing), - (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.duplicateField")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.duplicateField", f)) (checkDuplicateFields path (Lists.map Core.caseAlternativeName csCases))) Nothing)]) + (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.duplicateField")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.duplicateField", f)) (checkDuplicateFields path (Lists.map Core.caseAlternativeName csCases))) Nothing), + (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.missingCaseBranches")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.missingCaseBranches", f)) (Logic.ifElse (Optionals.isNone csDefault) (Optionals.cases unionFields Nothing (\fields -> + let variantNames = Sets.fromList (Lists.map Core.fieldTypeName fields) + uncovered = Sets.difference variantNames altNames + in (Logic.ifElse (Sets.null uncovered) Nothing (Just (ErrorCore.InvalidTermErrorMissingCaseBranches (ErrorCore.MissingCaseBranchesError { + ErrorCore.missingCaseBranchesErrorLocation = path, + ErrorCore.missingCaseBranchesErrorTypeName = tname, + ErrorCore.missingCaseBranchesErrorVariantNames = (Sets.toList uncovered)})))))) Nothing)) Nothing), + (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unknownCaseAlternative")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unknownCaseAlternative", f)) (Optionals.cases unionFields Nothing (\fields -> + let variantNames = Sets.fromList (Lists.map Core.fieldTypeName fields) + unknown = Sets.difference altNames variantNames + in (Optionals.cases (Lists.head (Sets.toList unknown)) Nothing (\firstUnknown -> Just (ErrorCore.InvalidTermErrorUnknownCaseAlternative (ErrorCore.UnknownCaseAlternativeError { + ErrorCore.unknownCaseAlternativeErrorLocation = path, + ErrorCore.unknownCaseAlternativeErrorTypeName = tname, + ErrorCore.unknownCaseAlternativeErrorName = firstUnknown}))))))) Nothing)]) Core.TermTypeApplication v0 -> Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInTypeApplication")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInTypeApplication", f)) (Logic.ifElse typed (checkUndefinedTypeVariablesInType path cx (Core.typeApplicationTermType v0) (\uvName -> Just (ErrorCore.InvalidTermErrorUndefinedTypeVariableInTypeApplication (ErrorCore.UndefinedTypeVariableInTypeApplicationError { ErrorCore.undefinedTypeVariableInTypeApplicationErrorLocation = path, ErrorCore.undefinedTypeVariableInTypeApplicationErrorName = uvName})))) Nothing)) Nothing @@ -251,16 +271,18 @@ checkUndefinedTypeVariablesInType path cx typ mkError = let freeVars = Variables.freeVariablesInType typ - undefined = Sets.difference freeVars (Graph.graphTypeVariables cx) - in (Optionals.cases (Lists.maybeHead (Sets.toList undefined)) Nothing (\firstUndefined -> mkError firstUndefined)) + resolvedNames = Sets.union (Graph.graphTypeVariables cx) (Sets.fromList (Maps.keys (Graph.graphSchemaTypes cx))) + undefined = Sets.difference freeVars resolvedNames + in (Optionals.cases (Lists.head (Sets.toList undefined)) Nothing (\firstUndefined -> mkError firstUndefined)) -- | Check a type scheme for type variables not bound by the scheme or the current scope checkUndefinedTypeVariablesInTypeScheme :: t0 -> Graph.Graph -> Core.TypeScheme -> (Core.Name -> Maybe t1) -> Maybe t1 checkUndefinedTypeVariablesInTypeScheme path cx ts mkError = let freeVars = Variables.freeVariablesInTypeScheme ts - undefined = Sets.difference freeVars (Graph.graphTypeVariables cx) - in (Optionals.cases (Lists.maybeHead (Sets.toList undefined)) Nothing (\firstUndefined -> mkError firstUndefined)) + resolvedNames = Sets.union (Graph.graphTypeVariables cx) (Sets.fromList (Maps.keys (Graph.graphSchemaTypes cx))) + undefined = Sets.difference freeVars resolvedNames + in (Optionals.cases (Lists.head (Sets.toList undefined)) Nothing (\firstUndefined -> mkError firstUndefined)) -- | Return an error if the given type is TypeVoid checkVoid :: Core.Type -> Maybe ErrorCore.InvalidTypeError @@ -332,6 +354,7 @@ (Core.Name "hydra.error.core.InvalidTermError.invalidLambdaParameterName"), (Core.Name "hydra.error.core.InvalidTermError.invalidLetBindingName"), (Core.Name "hydra.error.core.InvalidTermError.invalidTypeLambdaParameterName"), + (Core.Name "hydra.error.core.InvalidTermError.missingCaseBranches"), (Core.Name "hydra.error.core.InvalidTermError.nestedTermAnnotation"), (Core.Name "hydra.error.core.InvalidTermError.redundantWrapUnwrap"), (Core.Name "hydra.error.core.InvalidTermError.selfApplication"), @@ -341,6 +364,7 @@ (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInBindingType"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInLambdaDomain"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInTypeApplication"), + (Core.Name "hydra.error.core.InvalidTermError.unknownCaseAlternative"), (Core.Name "hydra.error.core.InvalidTermError.unknownPrimitiveName"), (Core.Name "hydra.error.core.InvalidTermError.unnecessaryIdentityApplication"), (Core.Name "hydra.error.core.InvalidTermError.untypedTermVariable"), @@ -362,21 +386,33 @@ Validation.validationProfileMaxErrors = 1, Validation.validationProfileMaxWarnings = 20} +-- | Resolve a type name to the field list of the union type it names, or Nothing if it does not resolve to a union type. +resolveUnionFields :: Graph.Graph -> Core.Name -> Maybe [Core.FieldType] +resolveUnionFields cx tname = + + let toFields = + \ts -> + let stripped = Strip.deannotateType (Core.typeSchemeBody ts) + in case stripped of + Core.TypeUnion v0 -> Just v0 + _ -> Nothing + in (Optionals.cases (Maps.lookup tname (Graph.graphSchemaTypes cx)) (Optionals.cases (Maps.lookup tname (Graph.graphBoundTypes cx)) Nothing toFields) toFields) + -- | Validate a term against the given ValidationProfile, returning a ValidationResult. Errors hard-stop traversal once maxErrors is reached; warnings are bounded by maxWarnings without causing termination. term :: Validation.ValidationProfile -> Bool -> Graph.Graph -> Core.Term -> Validation.ValidationResult ErrorCore.InvalidTermError term p typed g t = - Rewriting.foldTermWithGraphAndPath (\recurse -> \path -> \cx -> \acc -> \trm -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( + Rewriting.foldTermWithGraphAndPath (\recurse -> \path -> \cx -> \acc -> \trm -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( let acc1 = appendFinding p acc (checkTerm p typed (Paths.SubtermPath path) cx trm) - in (Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc1)) (Validation.validationProfileMaxErrors p)) acc1 (recurse acc1 trm)))) g (Validation.ValidationResult { + in (Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc1)) (Validation.validationProfileMaxErrors p)) acc1 (recurse acc1 trm)))) g (Validation.ValidationResult { Validation.validationResultErrors = [], Validation.validationResultWarnings = []}) t -- | Validate a type against the given ValidationProfile, threading a ValidationResult accumulator through subtypes. Errors hard-stop traversal once maxErrors is reached. type_ :: Validation.ValidationProfile -> Validation.ValidationResult ErrorCore.InvalidTypeError -> S.Set Core.Name -> Core.Type -> Validation.ValidationResult ErrorCore.InvalidTypeError type_ p acc boundVars typ = - Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( + Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( let acc1 = appendFindingType p acc (validateTypeNode p boundVars typ) - in (Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc1)) (Validation.validationProfileMaxErrors p)) acc1 (case typ of + in (Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc1)) (Validation.validationProfileMaxErrors p)) acc1 (case typ of Core.TypeForall v0 -> let newBound = Sets.insert (Core.forallTypeParameter v0) boundVars in (type_ p acc1 newBound (Core.forallTypeBody v0)) @@ -464,7 +500,7 @@ Core.TypeUnion v0 -> firstFindingType [ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.emptyUnionType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.emptyUnionType", f)) (Logic.ifElse (Lists.null v0) (Just (ErrorCore.InvalidTypeErrorEmptyUnionType (ErrorCore.EmptyUnionTypeError { ErrorCore.emptyUnionTypeErrorLocation = (Paths.SubtermPath [])}))) Nothing)) Nothing, - (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion", f)) (Logic.ifElse (Equality.equal (Lists.length v0) 1) (Optionals.cases (Lists.maybeHead v0) Nothing (\singleField -> Just (ErrorCore.InvalidTypeErrorSingleVariantUnion (ErrorCore.SingleVariantUnionError { + (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion", f)) (Logic.ifElse (Equality.equal (Lists.length v0) 1) (Optionals.cases (Lists.head v0) Nothing (\singleField -> Just (ErrorCore.InvalidTypeErrorSingleVariantUnion (ErrorCore.SingleVariantUnionError { ErrorCore.singleVariantUnionErrorLocation = (Paths.SubtermPath []), ErrorCore.singleVariantUnionErrorFieldName = (Core.fieldTypeName singleField)})))) Nothing)) Nothing), (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.duplicateUnionTypeFieldNames")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.duplicateUnionTypeFieldNames", f)) (checkDuplicateFieldTypes v0 (\dupName -> Just (ErrorCore.InvalidTypeErrorDuplicateUnionTypeFieldNames (ErrorCore.DuplicateUnionTypeFieldNamesError { diff --git a/src/main/haskell/Hydra/Validate/Packaging.hs b/src/main/haskell/Hydra/Validate/Packaging.hs --- a/src/main/haskell/Hydra/Validate/Packaging.hs +++ b/src/main/haskell/Hydra/Validate/Packaging.hs @@ -9,6 +9,7 @@ import qualified Hydra.Coders as Coders import qualified Hydra.Constants as Constants import qualified Hydra.Core as Core +import qualified Hydra.Dependencies as Dependencies import qualified Hydra.Docs as Docs import qualified Hydra.Error.Checking as Checking import qualified Hydra.Error.Core as ErrorCore @@ -25,8 +26,9 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Overlay.Haskell.Lib.Regex as Regex +import qualified Hydra.Overlay.Haskell.Lib.Regex as LibRegex import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Names as Names @@ -34,6 +36,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths import qualified Hydra.Query as Query +import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational import qualified Hydra.System as System import qualified Hydra.Tabular as Tabular @@ -44,9 +47,12 @@ import qualified Hydra.Typing as Typing import qualified Hydra.Util as Util import qualified Hydra.Validation as Validation +import qualified Hydra.Variables as Variables import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +import qualified Data.Map as M +import qualified Data.Set as S -- | Append a rule-tagged InvalidModuleError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFindingModule :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 @@ -56,9 +62,9 @@ payload = Pairs.second rp errs = Validation.validationResultErrors acc wrns = Validation.validationResultWarnings acc - in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { + in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)), - Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { + Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { Validation.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -70,9 +76,9 @@ payload = Pairs.second rp errs = Validation.validationResultErrors acc wrns = Validation.validationResultWarnings acc - in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Equality.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { + in (Logic.ifElse (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Logic.ifElse (Ordering.lt (Lists.length errs) (Validation.validationProfileMaxErrors p)) (Validation.ValidationResult { Validation.validationResultErrors = (Lists.concat2 errs (Lists.singleton payload)), - Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Equality.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { + Validation.validationResultWarnings = wrns}) acc) (Logic.ifElse (Sets.member ruleName (Validation.validationProfileWarningRules p)) (Logic.ifElse (Ordering.lt (Lists.length wrns) (Validation.validationProfileMaxWarnings p)) (Validation.ValidationResult { Validation.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) @@ -111,7 +117,7 @@ Core.TypeUnion v1 -> Lists.foldl (\innerAcc -> \field -> Optionals.cases innerAcc ( let fieldName = Core.fieldTypeName field localFieldName = Names.localNameOf fieldName - constructorName = Strings.cat2 (Formatting.capitalize localTypeName) (Formatting.capitalize localFieldName) + constructorName = Strings.concat2 (Formatting.capitalize localTypeName) (Formatting.capitalize localFieldName) in (Logic.ifElse (Sets.member constructorName defNames) (Just (ErrorPackaging.InvalidModuleErrorConflictingVariantName (ErrorPackaging.ConflictingVariantNameError { ErrorPackaging.conflictingVariantNameErrorModuleName = ns, ErrorPackaging.conflictingVariantNameErrorTypeName = typeName, @@ -139,7 +145,7 @@ in case typ of Core.TypeAnnotated v1 -> Annotations.hasDescription (Annotations.getAnnotationMap (Core.annotatedTypeAnnotation v1)) _ -> False - Packaging.DefinitionPrimitive v0 -> Optionals.cases (Packaging.primitiveDefinitionMetadata v0) False (\em -> Logic.not (Equality.equal (Optionals.fromOptional "" (Packaging.entityMetadataDescription em)) "")) + Packaging.DefinitionPrimitive v0 -> Optionals.cases (Packaging.primitiveDefinitionMetadata v0) False (\em -> Logic.not (Equality.equal (Optionals.withDefault "" (Packaging.entityMetadataDescription em)) "")) _ -> False in (Logic.ifElse documented Nothing (Just (ErrorPackaging.InvalidModuleErrorMissingDocumentation (ErrorPackaging.MissingDocumentationError { ErrorPackaging.missingDocumentationErrorModuleName = ns, @@ -150,7 +156,7 @@ checkDefinitionModuleNames mod = let ns = Packaging.moduleName mod - prefix = Strings.cat2 (Packaging.unModuleName ns) "." + prefix = Strings.concat2 (Packaging.unModuleName ns) "." prefixLen = Strings.length prefix in (Lists.foldl (\acc -> \def -> Optionals.cases acc ( let name = definitionName def @@ -180,7 +186,7 @@ Packaging.DefinitionType _ -> Constants.regexPascalCase Packaging.DefinitionPrimitive _ -> Constants.regexCamelCase _ -> Constants.regexCamelCase - in (Logic.ifElse (Regex.matches pattern local) Nothing (Just (ErrorPackaging.InvalidModuleErrorInvalidDefinitionName (ErrorPackaging.InvalidDefinitionNameError { + in (Logic.ifElse (LibRegex.matches pattern local) Nothing (Just (ErrorPackaging.InvalidModuleErrorInvalidDefinitionName (ErrorPackaging.InvalidDefinitionNameError { ErrorPackaging.invalidDefinitionNameErrorModuleName = ns, ErrorPackaging.invalidDefinitionNameErrorName = name, ErrorPackaging.invalidDefinitionNameErrorExpectedConvention = expected}))))) (\_ -> acc)) Nothing (Packaging.moduleDefinitions mod)) @@ -199,7 +205,7 @@ currLocal = Names.localNameOf currName in (Optionals.cases prev (Just currName, Nothing) (\prevName -> let prevLocal = Names.localNameOf prevName - in (Logic.ifElse (Equality.lt prevLocal currLocal) (Just currName, Nothing) ( + in (Logic.ifElse (Ordering.lt prevLocal currLocal) (Just currName, Nothing) ( Just currName, (Just (ErrorPackaging.InvalidModuleErrorDefinitionsOutOfOrder (ErrorPackaging.DefinitionsOutOfOrderError { ErrorPackaging.definitionsOutOfOrderErrorModuleName = ns, @@ -246,7 +252,7 @@ checkModuleNameConvention mod = let ns = Packaging.moduleName mod - in (Logic.ifElse (Regex.matches Constants.regexNamespace (Packaging.unModuleName ns)) Nothing (Just (ErrorPackaging.InvalidModuleErrorInvalidModuleNameConvention (ErrorPackaging.InvalidModuleNameConventionError { + in (Logic.ifElse (LibRegex.matches Constants.regexNamespace (Packaging.unModuleName ns)) Nothing (Just (ErrorPackaging.InvalidModuleErrorInvalidModuleNameConvention (ErrorPackaging.InvalidModuleNameConventionError { ErrorPackaging.invalidModuleNameConventionErrorModuleName = ns})))) -- | Check that the package's name matches the hyphen-separated lowercase naming convention @@ -254,9 +260,29 @@ checkPackageNameConvention pkg = let pname = Packaging.packageName pkg - in (Logic.ifElse (Regex.matches Constants.regexPackageName (Packaging.unPackageName pname)) Nothing (Just (ErrorPackaging.InvalidPackageErrorInvalidPackageName (ErrorPackaging.InvalidPackageNameError { + in (Logic.ifElse (LibRegex.matches Constants.regexPackageName (Packaging.unPackageName pname)) Nothing (Just (ErrorPackaging.InvalidPackageErrorInvalidPackageName (ErrorPackaging.InvalidPackageNameError { ErrorPackaging.invalidPackageNameErrorPackageName = pname})))) +-- | Check a module's definitions for free names whose owning module is not among its declared dependencies +checkUndeclaredDependencies :: M.Map Core.Name Packaging.ModuleName -> S.Set Core.Name -> Packaging.Module -> [ErrorPackaging.InvalidPackageError] +checkUndeclaredDependencies owners primNames mod = + + let ns = Packaging.moduleName mod + visible = + Sets.insert ns (Sets.fromList (Lists.map (\dep -> Packaging.moduleDependencyModule dep) (Packaging.moduleDependencies mod))) + referencedNames = + \def -> case def of + Packaging.DefinitionTerm v0 -> Sets.union (Variables.freeVariablesInTerm (Packaging.termDefinitionBody v0)) (Dependencies.termDependencyNames False False True (Packaging.termDefinitionBody v0)) + Packaging.DefinitionType v0 -> Dependencies.typeDependencyNames False (Core.typeSchemeBody (Packaging.typeDefinitionBody v0)) + _ -> Sets.empty + findingForRef = + \refName -> Logic.ifElse (Sets.member refName primNames) Nothing (Optionals.bind (Maps.lookup refName owners) (\owner -> Logic.ifElse (Sets.member owner visible) Nothing (Just (ErrorPackaging.InvalidPackageErrorUndeclaredDependency (ErrorPackaging.UndeclaredDependencyError { + ErrorPackaging.undeclaredDependencyErrorModuleName = ns, + ErrorPackaging.undeclaredDependencyErrorReferencedName = refName, + ErrorPackaging.undeclaredDependencyErrorOwningModuleName = owner}))))) + findingsForDef = \def -> Optionals.mapOptional findingForRef (Sets.toList (referencedNames def)) + in (Lists.concat (Lists.map findingsForDef (Packaging.moduleDefinitions mod))) + -- | Extract the name from a definition definitionName :: Packaging.Definition -> Core.Name definitionName def = @@ -292,21 +318,47 @@ -- | Validate a kernel module against all kernel-default packaging rules; returns the first error found or nothing if valid. Convenience wrapper around 'module'' with 'kernelDefaultPackagingProfile'. kernelModule :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError kernelModule mod = - Lists.maybeHead (Validation.validationResultErrors (module_ kernelDefaultPackagingProfile (Validation.ValidationResult { + Lists.head (Validation.validationResultErrors (module_ kernelDefaultPackagingProfile (Validation.ValidationResult { Validation.validationResultErrors = [], Validation.validationResultWarnings = []}) mod)) -- | Validate a kernel package against all kernel-default packaging rules; returns the first error found or nothing if valid. Convenience wrapper around 'package' with 'kernelDefaultPackagingProfile'. kernelPackage :: Packaging.Package -> Maybe ErrorPackaging.InvalidPackageError kernelPackage pkg = - Lists.maybeHead (Validation.validationResultErrors (package kernelDefaultPackagingProfile (Validation.ValidationResult { + Lists.head (Validation.validationResultErrors (package kernelDefaultPackagingProfile (Validation.ValidationResult { Validation.validationResultErrors = [], Validation.validationResultWarnings = []}) pkg)) +-- | Non-kernel packaging profile (#575): identical to kernelDefaultPackagingProfile except the rules in kernelPackagingWarningRuleNamesForNonKernel (documentation, ordering, naming convention) are warnings, not errors, so each package's pre-existing backlog does not block sync until that package is promoted to the fully-fatal profile. +kernelPackagingProfileWithDocWarnings :: Validation.ValidationProfile +kernelPackagingProfileWithDocWarnings = + Validation.ValidationProfile { + Validation.validationProfileErrorRules = (Sets.fromList [ + Core.Name "hydra.error.packaging.InvalidModuleError.conflictingVariantName", + (Core.Name "hydra.error.packaging.InvalidModuleError.definitionNotInModuleName"), + (Core.Name "hydra.error.packaging.InvalidModuleError.duplicateDefinitionName"), + (Core.Name "hydra.error.packaging.InvalidModuleError.invalidModuleNameConvention"), + (Core.Name "hydra.error.packaging.InvalidPackageError.conflictingModuleName"), + (Core.Name "hydra.error.packaging.InvalidPackageError.duplicateModuleName"), + (Core.Name "hydra.error.packaging.InvalidPackageError.invalidPackageName")]), + Validation.validationProfileWarningRules = (Sets.fromList [ + Core.Name "hydra.error.packaging.InvalidModuleError.missingDocumentation", + (Core.Name "hydra.error.packaging.InvalidModuleError.definitionsOutOfOrder"), + (Core.Name "hydra.error.packaging.InvalidModuleError.invalidDefinitionName")]), + Validation.validationProfileMaxErrors = 1, + Validation.validationProfileMaxWarnings = 10000} + +-- | Check every module in the given universe for undeclared cross-module dependencies, returning every finding. +kernelUniverseUndeclaredDependencies :: [Packaging.Module] -> S.Set Core.Name -> [ErrorPackaging.InvalidPackageError] +kernelUniverseUndeclaredDependencies universe primNames = + + let owners = undeclaredDependencyOwners universe + in (Lists.concat (Lists.map (\mod -> checkUndeclaredDependencies owners primNames mod) universe)) + -- | Validate a module against the given ValidationProfile, accumulating findings into a ValidationResult. Errors hard-stop the rule sequence once maxErrors is reached. module_ :: Validation.ValidationProfile -> Validation.ValidationResult ErrorPackaging.InvalidModuleError -> Packaging.Module -> Validation.ValidationResult ErrorPackaging.InvalidModuleError module_ p acc0 mod = - Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingModule p acc guarded)) acc0 [ + Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingModule p acc guarded)) acc0 [ Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.conflictingVariantName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.conflictingVariantName", f)) (checkConflictingVariantNames mod)) Nothing, (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.missingDocumentation")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.missingDocumentation", f)) (checkDefinitionDocumentation mod)) Nothing), (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.invalidDefinitionName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.invalidDefinitionName", f)) (checkDefinitionNameConvention mod)) Nothing), @@ -320,11 +372,11 @@ package p acc0 pkg = let accPkg = - Lists.foldl (\acc -> \guarded -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingPackage p acc guarded)) acc0 [ + Lists.foldl (\acc -> \guarded -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc (appendFindingPackage p acc guarded)) acc0 [ Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidPackageError.conflictingModuleName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidPackageError.conflictingModuleName", f)) (checkConflictingModuleNames pkg)) Nothing, (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidPackageError.duplicateModuleName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidPackageError.duplicateModuleName", f)) (checkDuplicateModuleNames pkg)) Nothing), (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidPackageError.invalidPackageName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidPackageError.invalidPackageName", f)) (checkPackageNameConvention pkg)) Nothing)] - in (Lists.foldl (\acc -> \mod -> Logic.ifElse (Equality.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( + in (Lists.foldl (\acc -> \mod -> Logic.ifElse (Ordering.gte (Lists.length (Validation.validationResultErrors acc)) (Validation.validationProfileMaxErrors p)) acc ( let mr = module_ p (Validation.ValidationResult { Validation.validationResultErrors = [], @@ -338,3 +390,8 @@ in Validation.ValidationResult { Validation.validationResultErrors = newErrs, Validation.validationResultWarnings = newWrns})) accPkg (Packaging.packageModules pkg)) + +-- | Build a map from every name defined in the universe to its owning module +undeclaredDependencyOwners :: [Packaging.Module] -> M.Map Core.Name Packaging.ModuleName +undeclaredDependencyOwners universe = + Maps.fromList (Lists.concat (Lists.map (\m -> Lists.map (\def -> (definitionName def, (Packaging.moduleName m))) (Packaging.moduleDefinitions m)) universe)) diff --git a/src/main/haskell/Hydra/Variables.hs b/src/main/haskell/Hydra/Variables.hs --- a/src/main/haskell/Hydra/Variables.hs +++ b/src/main/haskell/Hydra/Variables.hs @@ -32,6 +32,7 @@ import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths 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.System as System @@ -106,7 +107,7 @@ v0] Core.TypeForall v0 -> collectVars (Sets.insert (Core.forallTypeParameter v0) boundVars) (Core.forallTypeBody v0) _ -> Lists.concat (Lists.map (collectVars boundVars) (Rewriting.subtypes t)) - in (Lists.nub (collectVars Sets.empty typ)) + in (Lists.distinct (collectVars Sets.empty typ)) -- | Find free variables in a type scheme freeVariablesInTypeScheme :: Core.TypeScheme -> S.Set Core.Name @@ -142,7 +143,7 @@ normalizeTypeVariablesInTerm :: Core.Term -> Core.Term normalizeTypeVariablesInTerm term = - let replaceName = \subst -> \v -> Optionals.fromOptional v (Maps.lookup v subst) + let replaceName = \subst -> \v -> Optionals.withDefault v (Maps.lookup v subst) substType = \subst -> \typ -> let rewrite = @@ -187,7 +188,7 @@ k = Lists.length vars gen = \i -> \rem -> \acc2 -> - let ti = Core.Name (Strings.cat2 "t" (Literals.showInt32 (Math.add next i))) + let ti = Core.Name (Strings.concat2 "t" (Literals.showInt32 (Math.add next i))) in (Logic.ifElse (Equality.equal rem 0) (Lists.reverse acc2) (gen (Math.add i 1) (Math.sub rem 1) (Lists.cons ti acc2))) newVars = gen 0 k [] newSubst = Maps.union (Maps.fromList (Lists.zip vars newVars)) subst @@ -197,7 +198,7 @@ \constraintMap -> Maps.fromList (Lists.map (\p -> let oldName = Pairs.first p meta = Pairs.second p - newName = Optionals.fromOptional oldName (Maps.lookup oldName newSubst) + newName = Optionals.withDefault oldName (Maps.lookup oldName newSubst) in (newName, meta)) (Maps.toList constraintMap)) oldConstraints = Core.typeSchemeConstraints ts newConstraints = Optionals.map renameConstraintKeys oldConstraints @@ -257,7 +258,7 @@ let replace = \recurse -> \typ2 -> case typ2 of - Core.TypeVariable v0 -> Core.TypeVariable (Optionals.fromOptional v0 (Maps.lookup v0 subst)) + Core.TypeVariable v0 -> Core.TypeVariable (Optionals.withDefault v0 (Maps.lookup v0 subst)) _ -> recurse typ2 in (Rewriting.rewriteType replace typ) @@ -278,7 +279,7 @@ let replace = \recurse -> \term2 -> case term2 of - Core.TermVariable v0 -> Core.TermVariable (Optionals.fromOptional v0 (Maps.lookup v0 subst)) + Core.TermVariable v0 -> Core.TermVariable (Optionals.withDefault v0 (Maps.lookup v0 subst)) Core.TermLambda v0 -> Optionals.cases (Maps.lookup (Core.lambdaParameter v0) subst) (recurse term2) (\_ -> term2) _ -> recurse term2 in (Rewriting.rewriteTerm replace term) @@ -289,7 +290,7 @@ let freshName = \base -> \i -> \m -> - let candidate = Core.Name (Strings.cat2 (Core.unName base) (Literals.showInt32 i)) + let candidate = Core.Name (Strings.concat2 (Core.unName base) (Literals.showInt32 i)) in (Logic.ifElse (Maps.member candidate m) (freshName base (Math.add i 1) m) candidate) f = \recurse -> \m -> \term -> case term of