diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,74 @@ --- +## [0.17.0] - 2026-07-01 + +Major themes: first-class support for effects and I/O in the kernel, TypeScript and +Scala reaching publishable parity with the other hosts, and continued maturation of +the published-host build model. + +### Highlights + +- **Effects and I/O** ([#286](https://github.com/CategoricalData/hydra/issues/286), + [#288](https://github.com/CategoricalData/hydra/issues/288), + [#494](https://github.com/CategoricalData/hydra/issues/494)): a new `effect` variant + on `hydra.core.Type` for representing effectful computations; new kernel modules + `hydra.file` (`FilePath`, `FileType`, `FileStatus`, `FileExtension`), `hydra.time` + (`Timespec`), and `hydra.error.file`; new primitive libraries `hydra.lib.effects`, + `hydra.lib.files`, and `hydra.lib.text` with byte-level I/O; and a new + `EffectfulTestCase` mechanism so the common test suite can exercise effectful + primitives across hosts. +- **TypeScript is a complete implementation** + ([#462](https://github.com/CategoricalData/hydra/issues/462)): self-hosts and passes + the common test suite, with a per-package npm publish pipeline + ([#492](https://github.com/CategoricalData/hydra/issues/492)). +- **Scala publishing**: per-package Maven Central publish infrastructure + ([#491](https://github.com/CategoricalData/hydra/issues/491)). +- **Published-host build model**: published mode now compiles the kernel from the + co-generated `dist/haskell` rather than Hackage, removing the need for a + `haskell=local` shim ([#500](https://github.com/CategoricalData/hydra/issues/500)); + the oil-and-water principle and cold-build workflow for `dist/haskell` are documented + ([#376](https://github.com/CategoricalData/hydra/issues/376)). +- **Kernel hygiene**: `uniqueLabel` (apostrophe suffixes) replaced by `chooseUniqueLabel` + (numeric suffixes) in `hydra.names` + ([#436](https://github.com/CategoricalData/hydra/issues/436)). + +### Implementations + +Eight hosts self-host and pass the common test suite across five families: Haskell, +Java, Python, Scala, and the four Lisp dialects (Clojure, Common Lisp, Scheme, Emacs +Lisp), with TypeScript now joining as a complete host/target. Go remains a "head bud" +(the coder still has emission bugs and the head's runtime is largely placeholder; it +does not yet host the test suite). + +### New Features + +- Translingual cross-reference convention for `doc` strings: doc-escape tags render to + each host's native doc syntax (Javadoc, Haddock, Sphinx, TSDoc) + ([#433](https://github.com/CategoricalData/hydra/issues/433)). +- Neo4j JSON-artifact validation demo, exercised across Java, Python, Haskell, and + TypeScript ([#510](https://github.com/CategoricalData/hydra/issues/510)). + +### Improvements + +- The Java/Maven publish set now covers every official Hydra target language, one coder + package per implementation family + ([#468](https://github.com/CategoricalData/hydra/issues/468)). +- JVM Maven artifact groups are bifurcated to `net.fortytwo.hydra.java` and + `net.fortytwo.hydra.scala`, so the Java and Scala (and future Clojure) publish sets + never collide on coordinates + ([#519](https://github.com/CategoricalData/hydra/issues/519)). +- Host-specific third-party integrations (the former `bindings/` tree) are folded into + `overlay/`, unifying hand-written host-native source under one tree + ([#511](https://github.com/CategoricalData/hydra/issues/511)). +- The coder de-parameterizes context and error types, simplifying generated coder + signatures ([#518](https://github.com/CategoricalData/hydra/issues/518)). +- TypeScript-to-Java generation now emits the `hydra.lib.*` aggregate namespace + interfaces (`Maps`, `Strings`, etc.) + ([#499](https://github.com/CategoricalData/hydra/issues/499)). + +--- + ## [0.16.1] - 2026-06-16 Major themes: the first release built by bootstrapping from previously published diff --git a/hydra-kernel.cabal b/hydra-kernel.cabal --- a/hydra-kernel.cabal +++ b/hydra-kernel.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-kernel -version: 0.16.1 +version: 0.17.0 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 @@ -41,18 +41,24 @@ Hydra.Decode.Ast Hydra.Decode.Coders Hydra.Decode.Core + Hydra.Decode.Docs Hydra.Decode.Error.Checking Hydra.Decode.Error.Core + Hydra.Decode.Error.File Hydra.Decode.Error.Packaging + Hydra.Decode.Error.System Hydra.Decode.Errors + Hydra.Decode.File Hydra.Decode.Json.Model Hydra.Decode.Packaging Hydra.Decode.Parsing Hydra.Decode.Paths Hydra.Decode.Query Hydra.Decode.Relational + Hydra.Decode.System Hydra.Decode.Tabular Hydra.Decode.Testing + Hydra.Decode.Time Hydra.Decode.Topology Hydra.Decode.Typed Hydra.Decode.Typing @@ -63,60 +69,43 @@ Hydra.Decoding Hydra.Dependencies Hydra.Differentiation - Hydra.Dsl.Annotations + Hydra.Docs Hydra.Dsl.Ast - Hydra.Dsl.AsTerm - Hydra.Dsl.AsType - Hydra.Dsl.Bootstrap Hydra.Dsl.Coders Hydra.Dsl.Core - Hydra.Dsl.Deep.Lib.Math + Hydra.Dsl.Docs 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.File Hydra.Dsl.Graph Hydra.Dsl.Json.Model - Hydra.Dsl.Libraries - Hydra.Dsl.Literals - Hydra.Dsl.LiteralTypes - Hydra.Dsl.Meta.Base - Hydra.Dsl.Meta.Common - Hydra.Dsl.Meta.Core - Hydra.Dsl.Meta.DeepCore - Hydra.Dsl.Meta.Graph - Hydra.Dsl.Meta.Lib.Chars - Hydra.Dsl.Meta.Lib.Eithers - Hydra.Dsl.Meta.Lib.Equality - Hydra.Dsl.Meta.Lib.Lists - Hydra.Dsl.Meta.Lib.Literals - Hydra.Dsl.Meta.Lib.Logic - Hydra.Dsl.Meta.Lib.Maps - Hydra.Dsl.Meta.Lib.Math - Hydra.Dsl.Meta.Lib.Optionals - Hydra.Dsl.Meta.Lib.Pairs - Hydra.Dsl.Meta.Lib.Regex - Hydra.Dsl.Meta.Lib.Sets - Hydra.Dsl.Meta.Lib.Strings - Hydra.Dsl.Meta.Literals - Hydra.Dsl.Meta.Phantoms - Hydra.Dsl.Meta.Tabular - Hydra.Dsl.Meta.Terms - Hydra.Dsl.Meta.Testing - Hydra.Dsl.Meta.Types - Hydra.Dsl.Meta.Variants + Hydra.Dsl.Lib.Chars + Hydra.Dsl.Lib.Eithers + Hydra.Dsl.Lib.Equality + 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.Pairs + Hydra.Dsl.Lib.Regex + Hydra.Dsl.Lib.Sets + Hydra.Dsl.Lib.Strings Hydra.Dsl.Packaging Hydra.Dsl.Parsing Hydra.Dsl.Paths - Hydra.Dsl.Prims Hydra.Dsl.Query Hydra.Dsl.Relational + Hydra.Dsl.System Hydra.Dsl.Tabular - Hydra.Dsl.Terms Hydra.Dsl.Testing - Hydra.Dsl.Tests + Hydra.Dsl.Time Hydra.Dsl.Topology - Hydra.Dsl.Types Hydra.Dsl.Typing Hydra.Dsl.Util Hydra.Dsl.Validation @@ -126,18 +115,24 @@ Hydra.Encode.Ast Hydra.Encode.Coders Hydra.Encode.Core + Hydra.Encode.Docs Hydra.Encode.Error.Checking Hydra.Encode.Error.Core + Hydra.Encode.Error.File Hydra.Encode.Error.Packaging + Hydra.Encode.Error.System Hydra.Encode.Errors + Hydra.Encode.File Hydra.Encode.Json.Model Hydra.Encode.Packaging Hydra.Encode.Parsing Hydra.Encode.Paths Hydra.Encode.Query Hydra.Encode.Relational + Hydra.Encode.System Hydra.Encode.Tabular Hydra.Encode.Testing + Hydra.Encode.Time Hydra.Encode.Topology Hydra.Encode.Typed Hydra.Encode.Typing @@ -149,26 +144,16 @@ Hydra.Environment Hydra.Error.Checking Hydra.Error.Core + Hydra.Error.File Hydra.Error.Packaging + Hydra.Error.System Hydra.Errors Hydra.Extract.Core Hydra.Extract.Json Hydra.Extract.Util + Hydra.File Hydra.Formatting Hydra.Graph - Hydra.Haskell.Lib.Chars - Hydra.Haskell.Lib.Eithers - Hydra.Haskell.Lib.Equality - Hydra.Haskell.Lib.Lists - Hydra.Haskell.Lib.Literals - Hydra.Haskell.Lib.Logic - Hydra.Haskell.Lib.Maps - Hydra.Haskell.Lib.Math - Hydra.Haskell.Lib.Optionals - Hydra.Haskell.Lib.Pairs - Hydra.Haskell.Lib.Regex - Hydra.Haskell.Lib.Sets - Hydra.Haskell.Lib.Strings Hydra.Hoisting Hydra.Inference Hydra.Json.Bootstrap @@ -184,8 +169,10 @@ Hydra.Languages Hydra.Lexical Hydra.Lib.Chars + Hydra.Lib.Effects Hydra.Lib.Eithers Hydra.Lib.Equality + Hydra.Lib.Files Hydra.Lib.Lists Hydra.Lib.Literals Hydra.Lib.Logic @@ -196,14 +183,58 @@ Hydra.Lib.Regex Hydra.Lib.Sets Hydra.Lib.Strings + Hydra.Lib.System + Hydra.Lib.Text Hydra.Literals Hydra.Names + Hydra.Overlay.Haskell.AsTerm + Hydra.Overlay.Haskell.AsType + Hydra.Overlay.Haskell.Bootstrap + Hydra.Overlay.Haskell.Dsl.Annotations + Hydra.Overlay.Haskell.Dsl.Deep.Lib.Math + Hydra.Overlay.Haskell.Dsl.Literals + Hydra.Overlay.Haskell.Dsl.LiteralTypes + Hydra.Overlay.Haskell.Dsl.Prims + Hydra.Overlay.Haskell.Dsl.Terms + Hydra.Overlay.Haskell.Dsl.Tests + Hydra.Overlay.Haskell.Dsl.Typed.Base + Hydra.Overlay.Haskell.Dsl.Typed.Common + Hydra.Overlay.Haskell.Dsl.Typed.Core + Hydra.Overlay.Haskell.Dsl.Typed.DeepCore + Hydra.Overlay.Haskell.Dsl.Typed.Graph + Hydra.Overlay.Haskell.Dsl.Typed.Literals + Hydra.Overlay.Haskell.Dsl.Typed.Phantoms + Hydra.Overlay.Haskell.Dsl.Typed.Tabular + Hydra.Overlay.Haskell.Dsl.Typed.Terms + Hydra.Overlay.Haskell.Dsl.Typed.Testing + Hydra.Overlay.Haskell.Dsl.Typed.Types + Hydra.Overlay.Haskell.Dsl.Typed.Variants + Hydra.Overlay.Haskell.Dsl.Types + Hydra.Overlay.Haskell.Lib.Chars + Hydra.Overlay.Haskell.Lib.Effects + Hydra.Overlay.Haskell.Lib.Eithers + Hydra.Overlay.Haskell.Lib.Equality + Hydra.Overlay.Haskell.Lib.Files + 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.Pairs + Hydra.Overlay.Haskell.Lib.Regex + Hydra.Overlay.Haskell.Lib.Sets + Hydra.Overlay.Haskell.Lib.Strings + Hydra.Overlay.Haskell.Lib.System + Hydra.Overlay.Haskell.Lib.Text + Hydra.Overlay.Haskell.Libraries Hydra.Packaging Hydra.Parsers Hydra.Parsing Hydra.Paths Hydra.Predicates Hydra.Query + Hydra.Read.Docs Hydra.Reduction Hydra.Reflect Hydra.Relational @@ -213,6 +244,7 @@ Hydra.Serialization Hydra.Settings Hydra.Show.Core + Hydra.Show.Docs Hydra.Show.Error.Core Hydra.Show.Error.Packaging Hydra.Show.Errors @@ -224,11 +256,13 @@ Hydra.Sorting Hydra.Strip Hydra.Substitution + Hydra.System Hydra.Tabular Hydra.Templates Hydra.Test.Transform Hydra.Test.Utils Hydra.Testing + Hydra.Time Hydra.Topology Hydra.Typed Hydra.Typing @@ -249,8 +283,11 @@ , base64-bytestring >=1.2.1 && <1.3 , bytestring >=0.11.5 && <0.13 , containers >=0.6.7 && <0.8 + , directory >=1.3.6 && <1.4 + , process >=1.6.0 && <1.7 , regex-tdfa >=1.3.2 && <1.4 , scientific >=0.3.7 && <0.4 , split >=0.2.3 && <0.3 , text >=2.0.2 && <2.2 + , time >=1.12.0 && <1.13 default-language: Haskell2010 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 @@ -1,32 +1,38 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Simple, one-way adapters for types and terms module Hydra.Adapt where + import qualified Hydra.Annotations as Annotations import qualified Hydra.Ast as Ast import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core import qualified Hydra.Dependencies as Dependencies +import qualified Hydra.Docs as Docs 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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as LibLiterals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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 LibLiterals +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.Literals as Literals import qualified Hydra.Names as Names import qualified Hydra.Packaging as Packaging @@ -43,8 +49,10 @@ 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 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 @@ -56,6 +64,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Adapt a graph and its schema to the given language constraints. The doExpand flag controls eta expansion of partial applications. Adaptation is type-preserving: binding-level TypeSchemes are adapted (not stripped). Note: case statement hoisting is done separately, prior to adaptation. The els0 parameter provides the original ordered bindings. Returns both the adapted graph and the ordered adapted bindings. adaptDataGraph :: Coders.LanguageConstraints -> Bool -> [Core.Binding] -> t0 -> Graph.Graph -> Either Errors.Error (Graph.Graph, [Core.Binding]) adaptDataGraph constraints doExpand els0 cx graph0 = @@ -106,6 +115,7 @@ Graph.graphSchemaTypes = adaptedSchemaTypes, Graph.graphTypeVariables = (Graph.graphTypeVariables adaptedGraphRaw)} in (Right (adaptedGraph, els1))))))))) + -- | Attempt to adapt a floating-point type using the given language constraints adaptFloatType :: Coders.LanguageConstraints -> Core.FloatType -> Maybe Core.FloatType adaptFloatType constraints ft = @@ -117,6 +127,7 @@ Core.FloatTypeFloat32 -> alt Core.FloatTypeFloat64 Core.FloatTypeFloat64 -> alt Core.FloatTypeFloat32 in (Logic.ifElse supported (Just ft) (forUnsupported ft)) + -- | Adapt a schema graph to the given language constraints adaptGraphSchema :: Ord t0 => (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> M.Map t0 Core.Type -> Either Errors.Error (M.Map t0 Core.Type)) adaptGraphSchema constraints litmap types0 = @@ -127,6 +138,7 @@ typ = Pairs.second pair in (Eithers.bind (adaptType constraints litmap typ) (\typ1 -> Right (name, typ1))) in (Eithers.bind (Eithers.mapList mapPair (Maps.toList types0)) (\pairs -> Right (Maps.fromList pairs))) + -- | Attempt to adapt an integer type using the given language constraints adaptIntegerType :: Coders.LanguageConstraints -> Core.IntegerType -> Maybe Core.IntegerType adaptIntegerType constraints it = @@ -145,6 +157,7 @@ Core.IntegerTypeUint32 -> alt Core.IntegerTypeInt64 Core.IntegerTypeUint64 -> alt Core.IntegerTypeBigint in (Logic.ifElse supported (Just it) (forUnsupported it)) + -- | Rewrite callback for adapting lambda domain types in a term adaptLambdaDomains :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> (t0 -> Either Errors.Error Core.Term) -> t0 -> Either Errors.Error Core.Term adaptLambdaDomains constraints litmap recurse term = @@ -154,6 +167,7 @@ Core.lambdaDomain = adaptedDomain, Core.lambdaBody = (Core.lambdaBody v0)}))) _ -> Right rewritten) + -- | Convert a literal to a different type adaptLiteral :: Core.LiteralType -> Core.Literal -> Core.Literal adaptLiteral lt l = @@ -175,6 +189,7 @@ Core.FloatValueFloat64 v3 -> v3)) Core.LiteralInteger v0 -> case lt of Core.LiteralTypeInteger v1 -> Core.LiteralInteger (Literals.bigintToIntegerValue v1 (Literals.integerValueToBigint v0)) + -- | Attempt to adapt a literal type using the given language constraints adaptLiteralType :: Coders.LanguageConstraints -> Core.LiteralType -> Maybe Core.LiteralType adaptLiteralType constraints lt = @@ -188,16 +203,19 @@ Core.LiteralTypeInteger v0 -> Optionals.map (\x -> Core.LiteralTypeInteger x) (adaptIntegerType constraints v0) _ -> Nothing in (Logic.ifElse (literalTypeSupported constraints lt) Nothing (forUnsupported lt)) + -- | Derive a map of adapted literal types for the given language constraints adaptLiteralTypesMap :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType 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))) + -- | 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) + -- | 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 adaptNestedTypes constraints litmap recurse term = @@ -212,6 +230,7 @@ Core.letBindings = adaptedBindings, Core.letBody = (Core.letBody v0)})))) _ -> Right rewritten) + -- | Adapt a primitive to the given language constraints, prior to inference adaptPrimitive :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Graph.Primitive -> Either Errors.Error Graph.Primitive adaptPrimitive constraints litmap prim0 = @@ -229,6 +248,7 @@ in (Right (Graph.Primitive { Graph.primitiveDefinition = def1, Graph.primitiveImplementation = (Graph.primitiveImplementation prim0)})))) + -- | Adapt a term using the given language constraints adaptTerm :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term adaptTerm constraints litmap cx graph term0 = @@ -258,6 +278,7 @@ 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)))) in (Rewriting.rewriteTermM rewrite term0) + -- | Adapt a term using the constraints of a given language adaptTermForLanguage :: Coders.Language -> t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term adaptTermForLanguage lang cx g term = @@ -265,6 +286,7 @@ let constraints = Coders.languageConstraints lang litmap = adaptLiteralTypesMap constraints in (adaptTerm constraints litmap cx g term) + -- | Adapt the types within a term signature to the given language constraints, in place. Parameter names, descriptions, and per-parameter isLazy flags, as well as type parameters, are preserved; only the parameter and result types are adapted. Unlike routing through TypeScheme (the type-only view), this retains the full TermSignature metadata, including primitive laziness flags. adaptTermSignature :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Typing.TermSignature -> Either Errors.Error Typing.TermSignature adaptTermSignature constraints litmap sig0 = @@ -280,6 +302,7 @@ Typing.termSignatureResult = Typing.Result { Typing.resultDescription = (Typing.resultDescription result0), Typing.resultType = resultType1}})))) + -- | Adapt a type using the given language constraints adaptType :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.Type -> Either Errors.Error Core.Type adaptType constraints litmap type0 = @@ -301,6 +324,7 @@ 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)) in (Rewriting.rewriteTypeM rewrite type0) + -- | Adapt a type using the constraints of a given language adaptTypeForLanguage :: Coders.Language -> Core.Type -> Either Errors.Error Core.Type adaptTypeForLanguage lang typ = @@ -308,6 +332,7 @@ let constraints = Coders.languageConstraints lang litmap = adaptLiteralTypesMap constraints in (adaptType constraints litmap typ) + -- | Adapt a type scheme to the given language constraints, prior to inference adaptTypeScheme :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.TypeScheme -> Either Errors.Error Core.TypeScheme adaptTypeScheme constraints litmap ts0 = @@ -318,12 +343,14 @@ Core.typeSchemeVariables = vars0, Core.typeSchemeBody = t1, Core.typeSchemeConstraints = (Core.typeSchemeConstraints ts0)}))) + -- | Compose two coders into a single coder -composeCoders :: Coders.Coder t0 t1 -> Coders.Coder t1 t2 -> Coders.Coder t0 t2 +composeCoders :: Coders.Coder t0 t1 t2 -> Coders.Coder t1 t3 t2 -> Coders.Coder t0 t3 t2 composeCoders c1 c2 = Coders.Coder { - Coders.coderEncode = (\cx -> \a -> Eithers.bind (Coders.coderEncode c1 cx a) (\b1 -> Coders.coderEncode c2 cx b1)), - Coders.coderDecode = (\cx -> \c -> Eithers.bind (Coders.coderDecode c2 cx c) (\b2 -> Coders.coderDecode c1 cx b2))} + Coders.coderEncode = (\a -> Eithers.bind (Coders.coderEncode c1 a) (\b1 -> Coders.coderEncode c2 b1)), + Coders.coderDecode = (\c -> Eithers.bind (Coders.coderDecode c2 c) (\b2 -> Coders.coderDecode c1 b2))} + -- | Given a data graph along with language constraints, original ordered bindings, and a designated list of namespaces, adapt the graph to the language constraints, then return the processed graph along with term definitions grouped by namespace (in the order of the input namespaces). Inference is performed before adaptation if bindings lack type annotations. Hoisting must preserve type schemes; if any binding loses its type scheme after hoisting, the pipeline fails. Adaptation preserves type application/lambda wrappers and adapts embedded types. Post-adaptation inference is performed to ensure binding TypeSchemes are fully consistent. The doExpand flag controls eta expansion. The doHoistCaseStatements flag controls case statement hoisting (needed for Python). The doHoistPolymorphicLetBindings flag controls polymorphic let binding hoisting (needed for Java). The originalBindings parameter provides the original ordered bindings (from module elements). dataGraphToDefinitions :: Coders.LanguageConstraints -> Bool -> Bool -> Bool -> Bool -> [Core.Binding] -> Graph.Graph -> [Packaging.ModuleName] -> Typing.InferenceContext -> Either Errors.Error (Graph.Graph, [[Packaging.TermDefinition]]) dataGraphToDefinitions constraints doInfer doExpand doHoistCaseStatements doHoistPolymorphicLetBindings originalBindings graph0 namespaces cx = @@ -459,6 +486,7 @@ Graph.graphSchemaTypes = (Graph.graphSchemaTypes adapted), Graph.graphTypeVariables = (Graph.graphTypeVariables g)}, defsGrouped)))))))) + -- | Check if a literal type is supported by the given language constraints literalTypeSupported :: Coders.LanguageConstraints -> Core.LiteralType -> Bool literalTypeSupported constraints lt = @@ -469,6 +497,7 @@ Core.LiteralTypeInteger v0 -> Sets.member v0 (Coders.languageConstraintsIntegerTypes constraints) _ -> True in (Logic.ifElse (Sets.member (Reflect.literalTypeVariant lt) (Coders.languageConstraintsLiteralVariants constraints)) (forType lt) False) + -- | Prepare a float type, substituting unsupported types prepareFloatType :: Ord t0 => (Core.FloatType -> (Core.FloatType, ((Core.FloatValue -> Core.FloatValue), (S.Set t0)))) prepareFloatType ft = @@ -487,6 +516,7 @@ Core.FloatValueFloat64 v1 -> Core.FloatValueFloat64 v1 _ -> v), Sets.empty)) + -- | Prepare an integer type, substituting unsupported types prepareIntegerType :: Core.IntegerType -> (Core.IntegerType, ((Core.IntegerValue -> Core.IntegerValue), (S.Set String))) prepareIntegerType it = @@ -524,6 +554,7 @@ (Sets.fromList [ "replace unsigned 64-bit integers with signed 64-bit integers"]))) _ -> prepareSame it + -- | Prepare a literal type, substituting unsupported types prepareLiteralType :: Core.LiteralType -> (Core.LiteralType, ((Core.Literal -> Core.Literal), (S.Set String))) prepareLiteralType at = @@ -569,9 +600,11 @@ _ -> v), msgs)) _ -> prepareSame at + -- | Return a value unchanged with identity transform and no messages prepareSame :: Ord t2 => (t0 -> (t0, ((t1 -> t1), (S.Set t2)))) prepareSame x = (x, ((\y -> y), Sets.empty)) + -- | Prepare a type, substituting unsupported literal types prepareType :: t0 -> Core.Type -> (Core.Type, ((Core.Term -> Core.Term), (S.Set String))) prepareType cx typ = @@ -589,6 +622,7 @@ _ -> v), msgs)) _ -> prepareSame typ + -- | Normalize a term by pushing TermTypeApplication inward past TermApplication and TermLambda. This corrects structures produced by poly-let hoisting and eta expansion, where type applications from inference end up wrapping term applications or lambda abstractions instead of being directly on the polymorphic variable. pushTypeAppsInward :: Core.Term -> Core.Term pushTypeAppsInward term = @@ -684,6 +718,7 @@ Core.wrappedTermTypeName = (Core.wrappedTermTypeName v0), Core.wrappedTermBody = (go (Core.wrappedTermBody v0))}) in (go term) + -- | Given a schema graph along with language constraints and a designated list of element names, adapt the graph to the language constraints, then return a corresponding type definition for each element name. schemaGraphToDefinitions :: Coders.LanguageConstraints -> Graph.Graph -> [[Core.Name]] -> t0 -> Either Errors.Error (M.Map Core.Name Core.Type, [[Packaging.TypeDefinition]]) schemaGraphToDefinitions constraints graph nameLists cx = @@ -701,8 +736,9 @@ in (Right ( tmap1, (Lists.map (\names -> Lists.map toDef (Optionals.mapOptional (\n -> Optionals.map (\t -> (n, t)) (Maps.lookup n tmap1)) names)) nameLists)))))) + -- | Given a target language and a source type, produce an adapter which rewrites the type and its terms according to the language's constraints. The encode direction adapts terms; the decode direction is identity. -simpleLanguageAdapter :: Coders.Language -> t0 -> Graph.Graph -> Core.Type -> Either Errors.Error (Coders.Adapter Core.Type Core.Type Core.Term Core.Term) +simpleLanguageAdapter :: Coders.Language -> t0 -> Graph.Graph -> Core.Type -> Either Errors.Error (Coders.Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error) simpleLanguageAdapter lang cx g typ = let constraints = Coders.languageConstraints lang @@ -712,8 +748,9 @@ Coders.adapterSource = typ, Coders.adapterTarget = adaptedType, Coders.adapterCoder = Coders.Coder { - Coders.coderEncode = (\cx2 -> \term -> adaptTerm constraints litmap cx2 g term), - Coders.coderDecode = (\cx2 -> \term -> Right term)}}))) + Coders.coderEncode = (\term -> adaptTerm constraints litmap cx g term), + Coders.coderDecode = (\term -> Right term)}}))) + -- | Find a list of alternatives for a given term, if any termAlternatives :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error [Core.Term] termAlternatives cx graph term = @@ -755,6 +792,7 @@ in (Right [ term2]) _ -> Right [] + -- | Find a list of alternatives for a given type, if any typeAlternatives :: Core.Type -> [Core.Type] typeAlternatives type_ = @@ -763,6 +801,8 @@ let type2 = Core.annotatedTypeBody v0 in [ type2] + Core.TypeEffect v0 -> [ + v0] Core.TypeOptional v0 -> [ Core.TypeList v0] Core.TypeUnion v0 -> 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Module dependency module name analysis module Hydra.Analysis where + import qualified Hydra.Annotations as Annotations import qualified Hydra.Arity as Arity import qualified Hydra.Ast as Ast @@ -11,22 +13,26 @@ 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.Encode.Core as EncodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -37,8 +43,10 @@ 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 @@ -49,6 +57,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | Add names to existing module names mapping addNamesToModuleNames :: (Packaging.ModuleName -> t0) -> S.Set Core.Name -> Util.ModuleNames t0 -> Util.ModuleNames t0 addNamesToModuleNames encodeModuleName names ns0 = @@ -58,14 +67,17 @@ in Util.ModuleNames { Util.moduleNamesFocus = (Util.moduleNamesFocus ns0), Util.moduleNamesMapping = (Maps.union (Util.moduleNamesMapping ns0) (Maps.fromList (Lists.map toPair (Sets.toList nss))))} + -- | Analyze a function term, collecting lambdas, type lambdas, lets, and type applications analyzeFunctionTerm :: Typing.InferenceContext -> (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t0) -> t0 -> Core.Term -> Either t1 (Typing.FunctionStructure t0) analyzeFunctionTerm cx getTC setTC env term = analyzeFunctionTermWith cx (\g -> \b -> Logic.ifElse (Predicates.isComplexBinding g b) (Just (Core.TermLiteral (Core.LiteralBoolean True))) Nothing) getTC setTC env term + -- | Analyze a function term with configurable binding metadata analyzeFunctionTermWith :: Typing.InferenceContext -> (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t0) -> t0 -> Core.Term -> Either t1 (Typing.FunctionStructure t0) analyzeFunctionTermWith cx forBinding getTC setTC env term = analyzeFunctionTermWithGather cx forBinding getTC setTC True env [] [] [] [] [] term + -- | Final step of the function-term walk: type-apply the body and assemble the FunctionStructure analyzeFunctionTermWithFinish :: Typing.InferenceContext -> (t0 -> Graph.Graph) -> t0 -> [Core.Name] -> [Core.Name] -> [Core.Binding] -> [Core.Type] -> [Core.Type] -> Core.Term -> Either t1 (Typing.FunctionStructure t0) analyzeFunctionTermWithFinish cx getTC fEnv tparams args bindings doms tapps body = @@ -83,6 +95,7 @@ Typing.functionStructureDomains = (Lists.reverse doms), Typing.functionStructureCodomain = mcod, Typing.functionStructureEnvironment = fEnv})) + -- | Recursive step of the function-term walk: peel lambdas / type-lambdas / type-applications, accumulating params and bindings, then call analyzeFunctionTermWithFinish analyzeFunctionTermWithGather :: Typing.InferenceContext -> (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t0) -> Bool -> t0 -> [Core.Name] -> [Core.Name] -> [Core.Binding] -> [Core.Type] -> [Core.Type] -> Core.Term -> Either t1 (Typing.FunctionStructure t0) analyzeFunctionTermWithGather cx forBinding getTC setTC argMode gEnv tparams args bindings doms tapps t = @@ -108,6 +121,7 @@ newEnv = setTC (Scoping.extendGraphForTypeLambda (getTC gEnv) v0) gEnv in (analyzeFunctionTermWithGather cx forBinding getTC setTC argMode newEnv (Lists.cons tvar tparams) args bindings doms tapps tlBody) _ -> analyzeFunctionTermWithFinish cx getTC gEnv tparams args bindings doms tapps t + -- | Get dependency module names from definitions definitionDependencyModuleNames :: [Packaging.Definition] -> S.Set Packaging.ModuleName definitionDependencyModuleNames defs = @@ -119,6 +133,7 @@ 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)))) + -- | 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) dependencyModuleNames cx graph binds withPrims withNoms withSchema els = @@ -140,6 +155,7 @@ dataNames, schemaNames])))) in (Eithers.map (\namesList -> Sets.fromList (Optionals.cat (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) gatherApplications term = @@ -152,6 +168,7 @@ in (go (Lists.cons rhs args) lhs) _ -> (args, t) in (go [] term) + -- | Gather term arguments, stripping type-level constructs gatherArgs :: Core.Term -> [Core.Term] -> (Core.Term, [Core.Term]) gatherArgs term args = @@ -167,6 +184,7 @@ let body = Core.typeApplicationTermBody v0 in (gatherArgs body args) _ -> (term, args) + -- | Gather term and type arguments from a term gatherArgsWithTypeApps :: Core.Term -> [Core.Term] -> [Core.Type] -> (Core.Term, ([Core.Term], [Core.Type])) gatherArgsWithTypeApps term args tyArgs = @@ -183,12 +201,14 @@ typ = Core.typeApplicationTermType v0 in (gatherArgsWithTypeApps body args (Lists.cons typ tyArgs)) _ -> (term, (args, tyArgs)) + -- | Check if a term body is self-tail-recursive with respect to a function name isSelfTailRecursive :: Core.Name -> Core.Term -> Bool isSelfTailRecursive funcName body = let callsSelf = Logic.not (Variables.isFreeVariableInTerm funcName body) in (Logic.ifElse callsSelf (isTailRecursiveInTailPosition funcName body) False) + -- | Check if a term can be encoded as a simple assignment isSimpleAssignment :: Core.Term -> Bool isSimpleAssignment term = @@ -203,6 +223,7 @@ in case baseTerm of Core.TermCases _ -> False _ -> True + -- | Check that all self-references are in tail position isTailRecursiveInTailPosition :: Core.Name -> Core.Term -> Bool isTailRecursiveInTailPosition funcName term = @@ -239,6 +260,7 @@ Lists.foldl (\ok -> \b -> Logic.and ok (Variables.isFreeVariableInTerm funcName (Core.bindingTerm b))) True (Core.letBindings v0) in (Logic.and bindingsOk (isTailRecursiveInTailPosition funcName (Core.letBody v0))) _ -> Variables.isFreeVariableInTerm funcName term + -- | Check whether a module contains any binary literal values moduleContainsBinaryLiterals :: Packaging.Module -> Bool moduleContainsBinaryLiterals mod = @@ -255,6 +277,7 @@ Packaging.DefinitionTerm v0 -> Just (Packaging.termDefinitionBody v0) _ -> Nothing) (Packaging.moduleDefinitions mod)) in (Lists.foldl (\acc -> \t -> Logic.or acc (termContainsBinary t)) False defTerms) + -- | Check whether a module contains any decimal literal values moduleContainsDecimalLiterals :: Packaging.Module -> Bool moduleContainsDecimalLiterals mod = @@ -271,6 +294,7 @@ Packaging.DefinitionTerm v0 -> Just (Packaging.termDefinitionBody v0) _ -> Nothing) (Packaging.moduleDefinitions mod)) in (Lists.foldl (\acc -> \t -> Logic.or acc (termContainsDecimal t)) False defTerms) + -- | Find dependency module names in all elements of a module, excluding the module's own module name (Either version) moduleDependencyModuleNames :: t0 -> Graph.Graph -> Bool -> Bool -> Bool -> Bool -> Packaging.Module -> Either Errors.Error (S.Set Packaging.ModuleName) moduleDependencyModuleNames cx graph binds withPrims withNoms withSchema mod = @@ -297,6 +321,7 @@ Core.bindingTypeScheme = (Optionals.map Scoping.termSignatureToTypeScheme (Packaging.termDefinitionSignature v0))}) _ -> Nothing) (Packaging.moduleDefinitions mod)) in (Eithers.map (\deps -> Sets.delete (Packaging.moduleName mod) deps) (dependencyModuleNames cx graph binds withPrims withNoms withSchema allBindings)) + -- | Create module names mapping for definitions moduleNamesForDefinitions :: (Packaging.ModuleName -> t0) -> Packaging.ModuleName -> [Packaging.Definition] -> Util.ModuleNames t0 moduleNamesForDefinitions encodeModuleName focusNs defs = 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 @@ -1,29 +1,35 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Utilities for reading and writing type and term annotations module Hydra.Annotations 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.Decode.Core as DecodeCore +import qualified Hydra.Docs as Docs 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths @@ -32,8 +38,10 @@ 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 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 @@ -44,6 +52,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Aggregate annotations from nested structures aggregateAnnotations :: Ord t2 => ((t0 -> Maybe t1) -> (t1 -> t0) -> (t1 -> M.Map t2 t3) -> t0 -> M.Map t2 t3) aggregateAnnotations getValue getX getAnns t = @@ -51,12 +60,15 @@ let toPairs = \rest -> \t2 -> Optionals.cases (getValue t2) rest (\yy -> toPairs (Lists.cons (Maps.toList (getAnns yy)) rest) (getX yy)) in (Maps.fromList (Lists.concat (toPairs [] t))) + -- | Extract comments/description from a Binding commentsFromBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error (Maybe String) commentsFromBinding cx g b = getTermDescription cx g (Core.bindingTerm b) + -- | Extract comments/description from a FieldType commentsFromFieldType :: t0 -> Graph.Graph -> Core.FieldType -> Either Errors.Error (Maybe String) commentsFromFieldType cx g ft = getTypeDescription cx g (Core.fieldTypeType ft) + -- | Project a Map out of an annotation Term. For a TermMap with TermVariable-shaped keys (or, transitionally, TermWrap-encoded Name keys), returns those (Name, value) entries; for any other shape, returns the empty map. getAnnotationMap :: Core.Term -> M.Map Core.Name Core.Term getAnnotationMap t = @@ -78,13 +90,16 @@ in case t of Core.TermMap v0 -> Maps.fromList (Optionals.cat (Lists.map fromEntry (Maps.toList v0))) _ -> Maps.empty + -- | Get description from annotations map (Either version) getDescription :: t0 -> Graph.Graph -> M.Map Core.Name Core.Term -> Either Errors.Error (Maybe String) getDescription cx graph anns = Optionals.cases (Maps.lookup (Core.Name "description") anns) (Right Nothing) (\term -> Eithers.map Optionals.pure (ExtractCore.string graph term)) + -- | Get a term annotation getTermAnnotation :: Core.Name -> Core.Term -> Maybe Core.Term getTermAnnotation key term = Maps.lookup key (termAnnotationInternal term) + -- | Get term description (Either version) getTermDescription :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error (Maybe String) getTermDescription cx graph term = @@ -95,28 +110,35 @@ Core.TermTypeApplication v0 -> peel (Core.typeApplicationTermBody v0) _ -> t in (getDescription cx graph (termAnnotationInternal (peel term))) + -- | Get type from annotations getType :: Graph.Graph -> M.Map Core.Name Core.Term -> Either Errors.DecodingError (Maybe Core.Type) getType graph anns = Optionals.cases (Maps.lookup Constants.keyType anns) (Right Nothing) (\dat -> Eithers.map Optionals.pure (DecodeCore.type_ graph dat)) + -- | Get a type annotation getTypeAnnotation :: Core.Name -> Core.Type -> Maybe Core.Term getTypeAnnotation key typ = Maps.lookup key (typeAnnotationInternal typ) + -- | Get type classes from term. Each Set Name contains bare class identifiers (#275). getTypeClasses :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error (M.Map Core.Name (S.Set Core.Name)) getTypeClasses cx graph term = let decodeName = \term2 -> Eithers.bimap (\de -> Errors.ErrorDecoding de) (\x -> x) (DecodeCore.name graph term2) in (Optionals.cases (getTermAnnotation Constants.keyClasses term) (Right Maps.empty) (\term2 -> ExtractCore.map decodeName (ExtractCore.setOf decodeName graph) graph term2)) + -- | Get type description (Either version) getTypeDescription :: t0 -> Graph.Graph -> Core.Type -> Either Errors.Error (Maybe String) getTypeDescription cx graph typ = getDescription cx graph (typeAnnotationInternal typ) + -- | Check if annotations contain description hasDescription :: M.Map Core.Name t0 -> Bool hasDescription anns = Optionals.isGiven (Maps.lookup Constants.keyDescription anns) + -- | Check if type has description hasTypeDescription :: Core.Type -> Bool hasTypeDescription typ = hasDescription (typeAnnotationInternal typ) + -- | For a typed term, decide whether a coder should encode it as a native type expression, or as a Hydra type expression. isNativeType :: Core.Binding -> Bool isNativeType el = @@ -127,6 +149,7 @@ Core.typeSchemeVariables = [], Core.typeSchemeBody = (Core.TypeVariable (Core.Name "hydra.core.Type")), Core.typeSchemeConstraints = Nothing})) (Logic.not isFlaggedAsFirstClassType))) + -- | Normalize term annotations normalizeTermAnnotations :: Core.Term -> Core.Term normalizeTermAnnotations term = @@ -136,6 +159,7 @@ in (Logic.ifElse (Maps.null anns) stripped (Core.TermAnnotated (Core.AnnotatedTerm { Core.annotatedTermBody = stripped, Core.annotatedTermAnnotation = (wrapAnnotationMap anns)}))) + -- | Normalize type annotations normalizeTypeAnnotations :: Core.Type -> Core.Type normalizeTypeAnnotations typ = @@ -145,13 +169,16 @@ in (Logic.ifElse (Maps.null anns) stripped (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = stripped, Core.annotatedTypeAnnotation = (wrapAnnotationMap anns)}))) + -- | Set annotation in map setAnnotation :: Ord t0 => (t0 -> Maybe t1 -> M.Map t0 t1 -> M.Map t0 t1) setAnnotation key val m = Maps.alter (\_ -> val) key m + -- | Set description in annotations setDescription :: Maybe String -> M.Map Core.Name Core.Term -> M.Map Core.Name Core.Term setDescription d = setAnnotation Constants.keyDescription (Optionals.map (\arg_ -> (\x -> Core.TermLiteral x) ((\x -> Core.LiteralString x) arg_)) d) + -- | Set term annotation setTermAnnotation :: Core.Name -> Maybe Core.Term -> Core.Term -> Core.Term setTermAnnotation key val term = @@ -161,13 +188,16 @@ in (Logic.ifElse (Maps.null anns) term_ (Core.TermAnnotated (Core.AnnotatedTerm { Core.annotatedTermBody = term_, Core.annotatedTermAnnotation = (wrapAnnotationMap anns)}))) + -- | Set term description setTermDescription :: Maybe String -> Core.Term -> Core.Term setTermDescription d = setTermAnnotation Constants.keyDescription (Optionals.map (\s -> Core.TermLiteral (Core.LiteralString s)) d) + -- | Set type in annotations setType :: Maybe Core.Type -> M.Map Core.Name Core.Term -> M.Map Core.Name Core.Term setType mt = setAnnotation Constants.keyType (Optionals.map EncodeCore.type_ mt) + -- | Set type annotation setTypeAnnotation :: Core.Name -> Maybe Core.Term -> Core.Type -> Core.Type setTypeAnnotation key val typ = @@ -177,6 +207,7 @@ in (Logic.ifElse (Maps.null anns) typ_ (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = typ_, Core.annotatedTypeAnnotation = (wrapAnnotationMap anns)}))) + -- | Set type classes on term. The Set Name carries bare class identifiers (#275). setTypeClasses :: M.Map Core.Name (S.Set Core.Name) -> Core.Term -> Core.Term setTypeClasses m term = @@ -188,10 +219,12 @@ in (EncodeCore.name name, (Core.TermSet (Sets.fromList (Lists.map EncodeCore.name (Sets.toList classes))))) encoded = Logic.ifElse (Maps.null m) Nothing (Just (Core.TermMap (Maps.fromList (Lists.map encodePair (Maps.toList m))))) in (setTermAnnotation Constants.keyClasses encoded term) + -- | Set type description setTypeDescription :: Maybe String -> Core.Type -> Core.Type setTypeDescription d = setTypeAnnotation Constants.keyDescription (Optionals.map (\arg_ -> (\x -> Core.TermLiteral x) ((\x -> Core.LiteralString x) arg_)) d) + -- | Get internal term annotations termAnnotationInternal :: Core.Term -> M.Map Core.Name Core.Term termAnnotationInternal term = @@ -201,6 +234,7 @@ Core.TermAnnotated v0 -> Just v0 _ -> Nothing in (aggregateAnnotations getAnn (\at -> Core.annotatedTermBody at) (\at -> getAnnotationMap (Core.annotatedTermAnnotation at)) term) + -- | Get internal type annotations typeAnnotationInternal :: Core.Type -> M.Map Core.Name Core.Term typeAnnotationInternal typ = @@ -210,6 +244,7 @@ Core.TypeAnnotated v0 -> Just v0 _ -> Nothing in (aggregateAnnotations getAnn (\at -> Core.annotatedTypeBody at) (\at -> getAnnotationMap (Core.annotatedTypeAnnotation at)) typ) + -- | Wrap a Map as a TermMap annotation. Each Name key becomes a TermVariable. wrapAnnotationMap :: M.Map Core.Name Core.Term -> Core.Term wrapAnnotationMap m = 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 @@ -1,25 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions dealing with arguments and arity. module Hydra.Arity 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Math as Math +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Math as Math 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 @@ -28,10 +36,12 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Find the arity (expected number of arguments) of a primitive constant or function primitiveArity :: Graph.Primitive -> Int primitiveArity prim = Lists.length (Typing.termSignatureParameters (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition prim))) + -- | Find the arity (expected number of arguments) of a term termArity :: Core.Term -> Int termArity x = @@ -42,6 +52,7 @@ Core.TermProject _ -> 1 Core.TermUnwrap _ -> 1 _ -> 0 + -- | Find the arity (expected number of arguments) of a type typeArity :: Core.Type -> Int typeArity x = @@ -51,9 +62,11 @@ Core.TypeForall v0 -> typeArity (Core.forallTypeBody v0) Core.TypeFunction v0 -> Math.add 1 (typeArity (Core.functionTypeCodomain v0)) _ -> 0 + -- | Find the arity (expected number of arguments) of a type scheme typeSchemeArity :: Core.TypeScheme -> Int typeSchemeArity arg_ = typeArity (Core.typeSchemeBody arg_) + -- | Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b) uncurryType :: Core.Type -> [Core.Type] uncurryType t = diff --git a/src/main/haskell/Hydra/Ast.hs b/src/main/haskell/Hydra/Ast.hs --- a/src/main/haskell/Hydra/Ast.hs +++ b/src/main/haskell/Hydra/Ast.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model which provides a common syntax tree for Hydra serializers module Hydra.Ast where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Operator associativity data Associativity = AssociativityNone | @@ -12,11 +15,17 @@ AssociativityRight | AssociativityBoth deriving (Eq, Ord, Read, Show) + _Associativity = Core.Name "hydra.ast.Associativity" + _Associativity_none = Core.Name "none" + _Associativity_left = Core.Name "left" + _Associativity_right = Core.Name "right" + _Associativity_both = Core.Name "both" + -- | Formatting option for code blocks data BlockStyle = BlockStyle { @@ -27,10 +36,15 @@ -- | Whether to place a newline after the content blockStyleNewlineAfterContent :: Bool} deriving (Eq, Ord, Read, Show) + _BlockStyle = Core.Name "hydra.ast.BlockStyle" + _BlockStyle_indent = Core.Name "indent" + _BlockStyle_newlineBeforeContent = Core.Name "newlineBeforeContent" + _BlockStyle_newlineAfterContent = Core.Name "newlineAfterContent" + -- | An expression enclosed by brackets data BracketExpr = BracketExpr { @@ -41,10 +55,15 @@ -- | The formatting style for the bracketed block bracketExprStyle :: BlockStyle} deriving (Eq, Ord, Read, Show) + _BracketExpr = Core.Name "hydra.ast.BracketExpr" + _BracketExpr_brackets = Core.Name "brackets" + _BracketExpr_enclosed = Core.Name "enclosed" + _BracketExpr_style = Core.Name "style" + -- | Matching open and close bracket symbols data Brackets = Brackets { @@ -53,9 +72,13 @@ -- | The closing bracket symbol bracketsClose :: Symbol} deriving (Eq, Ord, Read, Show) + _Brackets = Core.Name "hydra.ast.Brackets" + _Brackets_open = Core.Name "open" + _Brackets_close = Core.Name "close" + -- | An abstract expression data Expr = -- | A constant symbol @@ -69,12 +92,19 @@ -- | A sequence of expressions joined by a separator, treated as structural layout (not subject to parenthesization) ExprSeq SeqExpr deriving (Eq, Ord, Read, Show) + _Expr = Core.Name "hydra.ast.Expr" + _Expr_const = Core.Name "const" + _Expr_indent = Core.Name "indent" + _Expr_op = Core.Name "op" + _Expr_brackets = Core.Name "brackets" + _Expr_seq = Core.Name "seq" + -- | Any of several indentation styles data IndentStyle = -- | Indent all lines with the given string @@ -82,9 +112,13 @@ -- | Indent only lines after the first with the given string IndentStyleSubsequentLines String deriving (Eq, Ord, Read, Show) + _IndentStyle = Core.Name "hydra.ast.IndentStyle" + _IndentStyle_allLines = Core.Name "allLines" + _IndentStyle_subsequentLines = Core.Name "subsequentLines" + -- | An expression indented in a certain style data IndentedExpression = IndentedExpression { @@ -93,9 +127,13 @@ -- | The expression to be indented indentedExpressionExpr :: Expr} deriving (Eq, Ord, Read, Show) + _IndentedExpression = Core.Name "hydra.ast.IndentedExpression" + _IndentedExpression_style = Core.Name "style" + _IndentedExpression_expr = Core.Name "expr" + -- | An operator symbol data Op = Op { @@ -108,11 +146,17 @@ -- | The associativity of the operator opAssociativity :: Associativity} deriving (Eq, Ord, Read, Show) + _Op = Core.Name "hydra.ast.Op" + _Op_symbol = Core.Name "symbol" + _Op_padding = Core.Name "padding" + _Op_precedence = Core.Name "precedence" + _Op_associativity = Core.Name "associativity" + -- | An operator expression data OpExpr = OpExpr { @@ -123,10 +167,15 @@ -- | The right-hand side operand opExprRhs :: Expr} deriving (Eq, Ord, Read, Show) + _OpExpr = Core.Name "hydra.ast.OpExpr" + _OpExpr_op = Core.Name "op" + _OpExpr_lhs = Core.Name "lhs" + _OpExpr_rhs = Core.Name "rhs" + -- | Left and right padding for an operator data Padding = Padding { @@ -135,15 +184,21 @@ -- | Padding to the right of the operator paddingRight :: Ws} deriving (Eq, Ord, Read, Show) + _Padding = Core.Name "hydra.ast.Padding" + _Padding_left = Core.Name "left" + _Padding_right = Core.Name "right" + -- | Operator precedence newtype Precedence = Precedence { unPrecedence :: Int} deriving (Eq, Ord, Read, Show) + _Precedence = Core.Name "hydra.ast.Precedence" + -- | A sequence of expressions joined by a separator operator. Unlike OpExpr, parenthesize ignores SeqExpr boundaries. data SeqExpr = SeqExpr { @@ -152,15 +207,21 @@ -- | The expressions to join seqExprElements :: [Expr]} deriving (Eq, Ord, Read, Show) + _SeqExpr = Core.Name "hydra.ast.SeqExpr" + _SeqExpr_op = Core.Name "op" + _SeqExpr_elements = Core.Name "elements" + -- | Any symbol newtype Symbol = Symbol { unSymbol :: String} deriving (Eq, Ord, Read, Show) + _Symbol = Core.Name "hydra.ast.Symbol" + -- | One of several classes of whitespace data Ws = -- | No whitespace @@ -174,9 +235,15 @@ -- | Two line breaks WsDoubleBreak deriving (Eq, Ord, Read, Show) + _Ws = Core.Name "hydra.ast.Ws" + _Ws_none = Core.Name "none" + _Ws_space = Core.Name "space" + _Ws_break = Core.Name "break" + _Ws_breakAndIndent = Core.Name "breakAndIndent" + _Ws_doubleBreak = Core.Name "doubleBreak" 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 @@ -1,31 +1,37 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Type checking and type reconstruction (type-of) for the results of Hydra unification and inference module Hydra.Checking 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.Dependencies as Dependencies +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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -41,8 +47,10 @@ 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 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 @@ -54,6 +62,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | True if every element of the list is equal to every other element (vacuously true for the empty list) allEqual :: Eq t0 => ([t0] -> Bool) allEqual els = @@ -61,6 +70,7 @@ let h = Pairs.first uc 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 applyTypeArgumentsToType :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Type -> Either Errors.Error Core.Type applyTypeArgumentsToType cx tx typeArgs t = @@ -96,6 +106,7 @@ ". Context has vars: {", (Strings.intercalate ", " (Lists.map Core.unName (Maps.keys (Graph.graphBoundTypes tx)))), "}"])})))) + -- | Check that a term has no unbound type variables (Either version) checkForUnboundTypeVariables :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error () checkForUnboundTypeVariables cx tx term0 = @@ -129,6 +140,7 @@ _ -> dflt 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 = @@ -143,6 +155,7 @@ 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 = @@ -152,6 +165,7 @@ 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 = @@ -160,6 +174,7 @@ 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 ())) + -- | Sanity-check a type substitution arising from unification. Specifically, check that schema types have not been inappropriately unified with type variables inferred from terms. checkTypeSubst :: t0 -> Graph.Graph -> Typing.TypeSubst -> Either Errors.Error Typing.TypeSubst checkTypeSubst cx tx subst = @@ -179,9 +194,11 @@ printPair = \p -> Strings.cat2 (Strings.cat2 (Core.unName (Pairs.first p)) " --> ") (ShowCore.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 = @@ -189,6 +206,7 @@ let vars = Graph.graphTypeVariables tx 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. normalizeTypeFreeVars :: Core.Type -> Core.Type normalizeTypeFreeVars typ = @@ -199,13 +217,16 @@ _ -> acc subst = Rewriting.foldOverType Coders.TraversalOrderPre collectVars Maps.empty typ in (Variables.substituteTypeVariables subst typ) + -- | Get the bound types from a graph as a type environment toFContext :: Graph.Graph -> M.Map Core.Name Core.Type toFContext cx = Maps.map Scoping.typeSchemeToFType (Graph.graphBoundTypes cx) + -- | Check whether two lists of types are effectively equal, disregarding type aliases typeListsEffectivelyEqual :: Graph.Graph -> [Core.Type] -> [Core.Type] -> Bool 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 typeOf :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOf cx tx typeArgs term = @@ -235,9 +256,11 @@ Core.TermWrap v0 -> typeOfWrappedTerm cx1 tx typeArgs v0 _ -> Left (Errors.ErrorChecking (Checking.CheckingErrorUnsupportedTermVariant (Checking.UnsupportedTermVariantError { Checking.unsupportedTermVariantErrorTermVariant = (Reflect.termVariant term)}))) + -- | Reconstruct the type of an annotated term (Either/InferenceContext version) 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) typeOfApplication :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Application -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfApplication cx tx typeArgs app = @@ -270,6 +293,7 @@ let t = Pairs.first result3 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) typeOfCaseStatement :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.CaseStatement -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfCaseStatement cx tx typeArgs cs = @@ -304,6 +328,7 @@ Core.functionTypeDomain = (Resolution.nominalApplication tname typeArgs), Core.functionTypeCodomain = cod}), cx3))))))))) + -- | Reconstruct the type of an either value (Either/InferenceContext version) typeOfEither :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Either Core.Term Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfEither cx tx typeArgs et = @@ -336,6 +361,7 @@ Core.eitherTypeLeft = ta0, Core.eitherTypeRight = rightType}), cx2)))) et) arityErr))))) + -- | Reconstruct the type of a union injection (Either/InferenceContext version) typeOfInjection :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Injection -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfInjection cx tx typeArgs injection = @@ -350,6 +376,7 @@ svars = Core.typeSchemeVariables schemaType 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) typeOfLambda :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Lambda -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfLambda cx tx typeArgs l = @@ -379,6 +406,7 @@ let tbody = Pairs.first tbodyResult 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) typeOfLet :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Let -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfLet cx tx typeArgs letTerm = @@ -409,6 +437,7 @@ let t = Pairs.first tResult 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) typeOfList :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> [Core.Term] -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfList cx tx typeArgs els = @@ -432,12 +461,14 @@ let eltypes = Pairs.first foldR 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) 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) 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 = @@ -486,6 +517,7 @@ in (Eithers.bind (checkSameType cx3 tx "map values" valTypes) (\vt -> Eithers.bind (applyTypeArgumentsToType cx3 tx typeArgs (Core.TypeMap (Core.MapType { Core.mapTypeKeys = kt, Core.mapTypeValues = vt}))) (\applied -> Right (applied, cx3)))))))))))) + -- | Reconstruct the type of an optional value (Either/InferenceContext version) typeOfMaybe :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Maybe Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfMaybe cx tx typeArgs mt = @@ -507,6 +539,7 @@ t = Core.TypeOptional termType 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) typeOfPair :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> (Core.Term, Core.Term) -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfPair cx tx typeArgs p = @@ -532,6 +565,7 @@ Checking.typeArityMismatchErrorExpectedArity = 2, Checking.typeArityMismatchErrorActualArity = n, Checking.typeArityMismatchErrorTypeArguments = typeArgs}))))) + -- | Reconstruct the type of a primitive function (Either/InferenceContext version) typeOfPrimitive :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfPrimitive cx tx typeArgs name = @@ -546,6 +580,7 @@ cx2 = Pairs.second instResult 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) typeOfProjection :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Projection -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfProjection cx tx typeArgs p = @@ -565,6 +600,7 @@ Core.functionTypeDomain = (Resolution.nominalApplication tname typeArgs), Core.functionTypeCodomain = sftyp}), cx2))))))) + -- | Reconstruct the type of a record (Either/InferenceContext version) typeOfRecord :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Record -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfRecord cx tx typeArgs record = @@ -582,6 +618,7 @@ in (Eithers.bind foldResult (\foldR -> let cx2 = Pairs.second foldR in (Right (Resolution.nominalApplication tname typeArgs, cx2)))) + -- | Reconstruct the type of a set (Either/InferenceContext version) typeOfSet :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> S.Set Core.Term -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfSet cx tx typeArgs els = @@ -605,9 +642,11 @@ let eltypes = Pairs.first foldR cx2 = Pairs.second foldR in (Eithers.bind (checkSameType cx2 tx "set elements" eltypes) (\unifiedType -> Right (Core.TypeSet unifiedType, cx2))))))) + -- | Check the type of a term 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) typeOfTypeApplication :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.TypeApplicationTerm -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfTypeApplication cx tx typeArgs tyapp = @@ -615,6 +654,7 @@ let body = Core.typeApplicationTermBody tyapp 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) typeOfTypeLambda :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.TypeLambda -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfTypeLambda cx tx typeArgs tl = @@ -638,10 +678,12 @@ in (Eithers.bind (applyTypeArgumentsToType cx2 tx typeArgs (Core.TypeForall (Core.ForallType { Core.forallTypeParameter = v, Core.forallTypeBody = t1}))) (\applied -> Right (applied, cx2))))) + -- | Reconstruct the type of the unit term (Either/InferenceContext version) 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) typeOfUnwrap :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfUnwrap cx tx typeArgs tname = @@ -658,6 +700,7 @@ Core.functionTypeDomain = (Resolution.nominalApplication tname typeArgs), Core.functionTypeCodomain = swrapped}), cx2))))) + -- | Reconstruct the type of a variable (Either/InferenceContext version) typeOfVariable :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.Name -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfVariable cx tx typeArgs name = @@ -674,6 +717,7 @@ in (Optionals.cases primScheme (Optionals.cases (Maps.lookup name (Graph.graphBoundTypes tx)) (Left (Errors.ErrorUntypedTermVariable (ErrorCore.UntypedTermVariableError { ErrorCore.untypedTermVariableErrorLocation = (Paths.SubtermPath []), ErrorCore.untypedTermVariableErrorName = name}))) forScheme) forScheme) + -- | Reconstruct the type of a wrapped term (Either/InferenceContext version) typeOfWrappedTerm :: Typing.InferenceContext -> Graph.Graph -> [Core.Type] -> Core.WrappedTerm -> Either Errors.Error (Core.Type, Typing.InferenceContext) typeOfWrappedTerm cx tx typeArgs wt = @@ -683,6 +727,7 @@ in (Eithers.bind (typeOf cx tx [] body) (\result -> let cx2 = Pairs.second result in (Right (Resolution.nominalApplication tname typeArgs, cx2)))) + -- | Check whether a list of types are effectively equal, disregarding type aliases and free type variable naming. Also treats free type variables (not in schema) as wildcards, since inference has already verified consistency. typesAllEffectivelyEqual :: Graph.Graph -> [Core.Type] -> Bool typesAllEffectivelyEqual tx tlist = @@ -695,6 +740,7 @@ in (Logic.not (Sets.null (Sets.difference allVars schemaNames))) 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 typesEffectivelyEqual :: Graph.Graph -> Core.Type -> Core.Type -> Bool typesEffectivelyEqual tx t1 t2 = 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Registry of Hydra's built-in type classes. module Hydra.Classes 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 @@ -16,8 +22,10 @@ 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 @@ -26,10 +34,12 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | The equality type class: instances support structural equality. equality :: Typing.TypeClass equality = Typing.TypeClass { Typing.typeClassDescription = "Equality: instances support structural equality."} + -- | The ordering type class: instances support total ordering (and equality). ordering :: Typing.TypeClass ordering = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Pure code generation pipeline for bootstrapping Hydra across languages. module Hydra.Codegen where + import qualified Hydra.Adapt as Adapt import qualified Hydra.Annotations as Annotations import qualified Hydra.Ast as Ast @@ -11,14 +13,18 @@ import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Packaging as DecodePackaging import qualified Hydra.Decoding as Decoding +import qualified Hydra.Docs as Docs import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Packaging as EncodePackaging import qualified Hydra.Encoding as Encoding 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.Inference as Inference import qualified Hydra.Json.Decode as Decode @@ -26,16 +32,16 @@ import qualified Hydra.Json.Model as Model import qualified Hydra.Json.Writer as Writer import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -46,8 +52,10 @@ 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 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 @@ -58,9 +66,11 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Build a schema map (Name -> Type) from a graph's schema types buildSchemaMap :: Graph.Graph -> M.Map Core.Name Core.Type buildSchemaMap g = Maps.map (\ts -> Strip.deannotateType (Core.typeSchemeBody ts)) (Graph.graphSchemaTypes g) + -- | Decode a single module from a JSON value decodeModuleFromJson :: Graph.Graph -> [Packaging.Module] -> Model.Value -> Either Errors.Error Packaging.Module decodeModuleFromJson bsGraph universeModules jsonVal = @@ -69,6 +79,7 @@ schemaMap = buildSchemaMap graph modType = Core.TypeVariable (Core.Name "hydra.packaging.Module") in (Eithers.either (\err -> Left (Errors.ErrorOther (Errors.OtherError err))) (\term -> Eithers.either (\decErr -> Left (Errors.ErrorDecoding decErr)) (\mod -> Right mod) (DecodePackaging.module_ graph term)) (Decode.fromJson schemaMap (Core.Name "hydra.packaging.Module") modType jsonVal)) + -- | Escape unescaped control characters inside JSON string literals escapeControlCharsInJson :: [Int] -> [Int] escapeControlCharsInJson input = @@ -88,6 +99,7 @@ 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 (go False False input) + -- | Format a primitive for the lexicon formatPrimitive :: Graph.Primitive -> String formatPrimitive prim = @@ -96,6 +108,7 @@ typ = Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition prim)) typeStr = ShowCore.typeScheme typ in (Strings.cat2 (Strings.cat2 (Strings.cat2 " " name) " : ") typeStr) + -- | Format a term binding for the lexicon formatTermBinding :: Core.Binding -> String formatTermBinding binding = @@ -103,10 +116,12 @@ 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) + -- | 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))) + -- | 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] generateCoderModules codec bsGraph universeModules typeModules cx = @@ -142,6 +157,7 @@ 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)) + -- | Generate the lexicon content from a graph generateLexicon :: Graph.Graph -> Either Errors.Error String generateLexicon graph = @@ -158,6 +174,7 @@ 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))))) + -- | 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)]) generateSourceFiles printDefinitions lang doInfer bsGraph universeModules modsToGenerate cx = @@ -272,6 +289,7 @@ let mod = Pairs.first p defs = Pairs.second p in (Eithers.map (\m -> Maps.toList m) (printDefinitions mod (Lists.map (\d -> Packaging.DefinitionTerm d) defs) cx g1))) (Lists.zip refreshedMods dedupedDefLists))))))) (\termFiles -> Right (Lists.concat2 schemaFiles termFiles)))) + -- | Perform type inference and generate the lexicon for a set of modules inferAndGenerateLexicon :: Typing.InferenceContext -> Graph.Graph -> [Packaging.Module] -> Either Errors.Error String inferAndGenerateLexicon cx bsGraph kernelModules = @@ -287,6 +305,7 @@ in (Eithers.bind (Inference.inferGraphTypes cx dataElements g0) (\inferResultWithCx -> let g1 = Pairs.first (Pairs.first inferResultWithCx) in (generateLexicon g1))) + -- | Perform type inference on modules and reconstruct with inferred types inferModules :: Typing.InferenceContext -> Graph.Graph -> [Packaging.Module] -> [Packaging.Module] -> Either Errors.Error [Packaging.Module] inferModules cx bsGraph universeMods targetMods = @@ -303,6 +322,7 @@ let inferResult = Pairs.first inferResultWithCx inferredElements = Pairs.second inferResult in (Right (Lists.map (refreshModule inferredElements) targetMods)))) + -- | Infer types for target modules in the context of a typed universe inferModulesGiven :: Typing.InferenceContext -> Graph.Graph -> [Packaging.Module] -> [Packaging.Module] -> Either Errors.Error [Packaging.Module] inferModulesGiven cx bsGraph universeMods targetMods = @@ -350,6 +370,7 @@ newlyInferredBindings = Pairs.second inferResult allInferredBindings = Lists.concat2 newlyInferredBindings untouchedTypedBindings in (Right (Lists.map (refreshModule allInferredBindings) targetMods)))) + -- | Lower Definition.primitive arms to Definition.term arms with term-encoded PrimitiveDefinition lowerPrimitiveDefinitions :: Packaging.Module -> Packaging.Module lowerPrimitiveDefinitions m = @@ -391,6 +412,7 @@ Packaging.moduleMetadata = (Packaging.moduleMetadata m), Packaging.moduleDependencies = newDeps, Packaging.moduleDefinitions = newDefs})) + -- | Compute transitive closure of dependencies for a set of modules moduleDepsTransitive :: M.Map Packaging.ModuleName Packaging.Module -> [Packaging.Module] -> [Packaging.Module] moduleDepsTransitive nsMap modules = @@ -398,9 +420,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))) + -- | 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)) + -- | Convert a Module to a JSON string moduleToJson :: M.Map Core.Name Core.Type -> Packaging.Module -> Either Errors.Error String moduleToJson schemaMap m = @@ -408,6 +432,7 @@ let term = EncodePackaging.module_ m modType = Core.TypeVariable (Core.Name "hydra.packaging.Module") in (Eithers.map (\json -> Writer.printJson json) (Eithers.bimap (\_e -> Errors.ErrorOther (Errors.OtherError _e)) (\_a -> _a) (Encode.toJson schemaMap (Core.Name "hydra.packaging.Module") modType term))) + -- | Convert a generated Module into a Source module moduleToSourceModule :: Packaging.Module -> Packaging.Module moduleToSourceModule m = @@ -437,6 +462,7 @@ Packaging.moduleDependencyPackage = Nothing}], Packaging.moduleDefinitions = [ moduleDef]} + -- | Build a graph from universe modules and working modules, using an explicit bootstrap graph modulesToGraph :: Graph.Graph -> [Packaging.Module] -> [Packaging.Module] -> Graph.Graph modulesToGraph bsGraph universeModules modules = @@ -488,6 +514,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives baseGraph), Graph.graphSchemaTypes = (Graph.graphSchemaTypes baseGraph), Graph.graphTypeVariables = (Graph.graphTypeVariables baseGraph)} + -- | Rebuild a module's term definitions using freshly inferred bindings refreshModule :: [Core.Binding] -> Packaging.Module -> Packaging.Module refreshModule inferredElements m = @@ -508,6 +535,7 @@ Packaging.termDefinitionSignature = (Optionals.map Scoping.typeSchemeToTermSignature (Core.bindingTypeScheme b)), Packaging.termDefinitionBody = (Core.bindingTerm b)})) (Lists.find (\b -> Equality.equal (Core.bindingName b) (Packaging.termDefinitionName v0)) inferredElements) Packaging.DefinitionPrimitive v0 -> Just (Packaging.DefinitionPrimitive v0)) (Packaging.moduleDefinitions m)))}) + -- | Compute transitive closure of module dependencies transitiveDeps :: (Packaging.Module -> [Packaging.ModuleName]) -> M.Map Packaging.ModuleName Packaging.Module -> [Packaging.Module] -> S.Set Packaging.ModuleName transitiveDeps getDeps nsMap startMods = diff --git a/src/main/haskell/Hydra/Coders.hs b/src/main/haskell/Hydra/Coders.hs --- a/src/main/haskell/Hydra/Coders.hs +++ b/src/main/haskell/Hydra/Coders.hs @@ -1,19 +1,22 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Abstractions for paired transformations between languages module Hydra.Coders where + import qualified Hydra.Core as Core import qualified Hydra.Errors as Errors +import qualified Hydra.File as File import qualified Hydra.Graph as Graph -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 import qualified Data.Set as S + -- | A two-level bidirectional encoder which adapts types to types and terms to terms -data Adapter t1 t2 v1 v2 = +data Adapter t1 t2 v1 v2 e = Adapter { -- | Whether information may be lost in the course of this adaptation adapterIsLossy :: Bool, @@ -22,12 +25,18 @@ -- | The target type adapterTarget :: t2, -- | The coder for transforming instances of the source type to instances of the target type - adapterCoder :: (Coder v1 v2)} + adapterCoder :: (Coder v1 v2 e)} + _Adapter = Core.Name "hydra.coders.Adapter" + _Adapter_isLossy = Core.Name "isLossy" + _Adapter_source = Core.Name "source" + _Adapter_target = Core.Name "target" + _Adapter_coder = Core.Name "coder" + -- | An evaluation context together with a source language and a target language data AdapterContext = AdapterContext { @@ -36,21 +45,30 @@ -- | The language being encoded or decoded adapterContextLanguage :: Language, -- | A map of type names to adapters for those types - adapterContextAdapters :: (M.Map Core.Name (Adapter Core.Type Core.Type Core.Term Core.Term))} + adapterContextAdapters :: (M.Map Core.Name (Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error))} + _AdapterContext = Core.Name "hydra.coders.AdapterContext" + _AdapterContext_graph = Core.Name "graph" + _AdapterContext_language = Core.Name "language" + _AdapterContext_adapters = Core.Name "adapters" + -- | A two-level encoder and decoder, operating both at a type level and an instance (data) level -data Bicoder t1 t2 v1 v2 = +data Bicoder t1 t2 v1 v2 e = Bicoder { -- | A function from source types to adapters - bicoderEncode :: (t1 -> Adapter t1 t2 v1 v2), + bicoderEncode :: (t1 -> Adapter t1 t2 v1 v2 e), -- | A function from target types to adapters - bicoderDecode :: (t2 -> Adapter t2 t1 v2 v1)} + bicoderDecode :: (t2 -> Adapter t2 t1 v2 v1 e)} + _Bicoder = Core.Name "hydra.coders.Bicoder" + _Bicoder_encode = Core.Name "encode" + _Bicoder_decode = Core.Name "decode" + -- | Per-target case conventions for name forms that vary across emission targets data CaseConventions = CaseConventions { @@ -75,35 +93,55 @@ -- | Convention for type-level variable names caseConventionsTypeVariable :: Util.CaseConvention} deriving (Eq, Ord, Read, Show) + _CaseConventions = Core.Name "hydra.coders.CaseConventions" + _CaseConventions_constant = Core.Name "constant" + _CaseConventions_directory = Core.Name "directory" + _CaseConventions_enumValue = Core.Name "enumValue" + _CaseConventions_field = Core.Name "field" + _CaseConventions_file = Core.Name "file" + _CaseConventions_module = Core.Name "module" + _CaseConventions_term = Core.Name "term" + _CaseConventions_termVariable = Core.Name "termVariable" + _CaseConventions_type = Core.Name "type" + _CaseConventions_typeVariable = Core.Name "typeVariable" --- | An encoder and decoder; a bidirectional transformation between two types -data Coder v1 v2 = + +-- | An encoder and decoder; a pair of partial functions between two types +data Coder v1 v2 e = Coder { - -- | A function which encodes source values as target values, given an InferenceContext for fresh-variable state and subterm-path tracing - coderEncode :: (Typing.InferenceContext -> v1 -> Either Errors.Error v2), - -- | A function which decodes target values as source values, given an InferenceContext for fresh-variable state and subterm-path tracing - coderDecode :: (Typing.InferenceContext -> v2 -> Either Errors.Error v1)} + -- | A function which encodes a domain value to a codomain value, with the possibility of failure + coderEncode :: (v1 -> Either e v2), + -- | A function which decodes a codomain value to a domain value, with the possibility of failure + coderDecode :: (v2 -> Either e v1)} + _Coder = Core.Name "hydra.coders.Coder" + _Coder_encode = Core.Name "encode" + _Coder_decode = Core.Name "decode" + -- | Indicates either the 'out' or the 'in' direction of a coder data CoderDirection = CoderDirectionEncode | CoderDirectionDecode deriving (Eq, Ord, Read, Show) + _CoderDirection = Core.Name "hydra.coders.CoderDirection" + _CoderDirection_encode = Core.Name "encode" + _CoderDirection_decode = Core.Name "decode" + -- | A named language together with its grammar constraints, capability profile, naming conventions, and conventional file extension data Language = Language { @@ -116,13 +154,20 @@ -- | Per-target case conventions for the various kinds of identifiers emitted by the coder languageCaseConventions :: CaseConventions, -- | Conventional file extension for emitted source files, without the leading dot (e.g. "scala", "py") - languageDefaultFileExtension :: Util.FileExtension} + languageDefaultFileExtension :: File.FileExtension} + _Language = Core.Name "hydra.coders.Language" + _Language_name = Core.Name "name" + _Language_constraints = Core.Name "constraints" + _Language_supportedFeatures = Core.Name "supportedFeatures" + _Language_caseConventions = Core.Name "caseConventions" + _Language_defaultFileExtension = Core.Name "defaultFileExtension" + -- | A set of constraints on valid type and term expressions, characterizing a language data LanguageConstraints = LanguageConstraints { @@ -138,13 +183,21 @@ languageConstraintsTypeVariants :: (S.Set Variants.TypeVariant), -- | A logical set of types, as a predicate which tests a type for inclusion languageConstraintsTypes :: (Core.Type -> Bool)} + _LanguageConstraints = Core.Name "hydra.coders.LanguageConstraints" + _LanguageConstraints_literalVariants = Core.Name "literalVariants" + _LanguageConstraints_floatTypes = Core.Name "floatTypes" + _LanguageConstraints_integerTypes = Core.Name "integerTypes" + _LanguageConstraints_termVariants = Core.Name "termVariants" + _LanguageConstraints_typeVariants = Core.Name "typeVariants" + _LanguageConstraints_types = Core.Name "types" + -- | A target-language or target-runtime capability the coder may rely on. Absence from a Language's supportedFeatures set means the emitter must work around the missing capability. data LanguageFeature = -- | The target runtime can invoke an n-ary function with fewer than n arguments without error. When absent, the emitter eta-expands partially-applied terms. @@ -154,19 +207,28 @@ -- | The target language permits polymorphic let-bindings in expression position. When absent, the emitter hoists polymorphic lets to top level. LanguageFeatureNestedPolymorphicLetBindings deriving (Eq, Ord, Read, Show) + _LanguageFeature = Core.Name "hydra.coders.LanguageFeature" + _LanguageFeature_partialApplication = Core.Name "partialApplication" + _LanguageFeature_nestedCaseStatements = Core.Name "nestedCaseStatements" + _LanguageFeature_nestedPolymorphicLetBindings = Core.Name "nestedPolymorphicLetBindings" + -- | The unique name of a language newtype LanguageName = LanguageName { unLanguageName :: String} deriving (Eq, Ord, Read, Show) + _LanguageName = Core.Name "hydra.coders.LanguageName" + -- | A bidirectional encoder which maps between the same type and term languages on either side -type SymmetricAdapter t v = (Adapter t t v v) +type SymmetricAdapter t v e = (Adapter t t v v e) + _SymmetricAdapter = Core.Name "hydra.coders.SymmetricAdapter" + -- | Specifies either a pre-order or post-order traversal data TraversalOrder = -- | Pre-order traversal @@ -174,9 +236,14 @@ -- | Post-order traversal TraversalOrderPost deriving (Eq, Ord, Read, Show) + _TraversalOrder = Core.Name "hydra.coders.TraversalOrder" + _TraversalOrder_pre = Core.Name "pre" + _TraversalOrder_post = Core.Name "post" + -- | A function which maps a Hydra type to a symmetric adapter between types and terms -type TypeAdapter = (AdapterContext -> Core.Type -> Either String (SymmetricAdapter Core.Type Core.Term)) +type TypeAdapter = (AdapterContext -> Core.Type -> Either String (SymmetricAdapter Core.Type Core.Term String)) + _TypeAdapter = Core.Name "hydra.coders.TypeAdapter" 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A module for tier-0 constants. module Hydra.Constants 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 @@ -16,8 +22,10 @@ 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 @@ -26,63 +34,83 @@ 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 ignoredVariable = "_" + -- | Annotation key for type classes keyClasses :: Core.Name keyClasses = Core.Name "classes" + -- | Annotation key for debug identifiers keyDebugId :: Core.Name keyDebugId = Core.Name "debugId" + -- | Annotation key for deprecated markers keyDeprecated :: Core.Name keyDeprecated = Core.Name "deprecated" + -- | Annotation key for descriptions keyDescription :: Core.Name keyDescription = Core.Name "description" + -- | Annotation key for exclusions keyExclude :: Core.Name keyExclude = Core.Name "exclude" + -- | A flag which tells the language coders to encode a given encoded type as a term rather than a native type keyFirstClassType :: Core.Name keyFirstClassType = Core.Name "firstClassType" + -- | A counter for generating fresh type variable names keyFreshTypeVariableCount :: Core.Name keyFreshTypeVariableCount = Core.Name "freshTypeVariableCount" + -- | Annotation key for maximum length constraints keyMaxLength :: Core.Name keyMaxLength = Core.Name "maxLength" + -- | Annotation key for minimum length constraints keyMinLength :: Core.Name keyMinLength = Core.Name "minLength" + -- | Annotation key for preserving field names during code generation keyPreserveFieldName :: Core.Name keyPreserveFieldName = Core.Name "preserveFieldName" + -- | Annotation key for type information keyType :: Core.Name keyType = Core.Name "type" + -- | The maximum value of a 32-bit integer maxInt32 :: Int maxInt32 = 2147483647 + -- | A maximum depth for nested computations. Currently, this is set very high because deep recursion is common in type inference over the Hydra kernel. maxTraceDepth :: Int maxTraceDepth = 5000 + -- | Regex matching a camelCase identifier: starts with a lowercase letter, then any letters or digits. regexCamelCase :: String regexCamelCase = "^[a-z][a-zA-Z0-9]*$" + -- | Regex matching a Hydra namespace: dot-separated camelCase segments, each starting with a lowercase letter. regexNamespace :: String regexNamespace = "^[a-z][a-zA-Z0-9]*(\\.[a-z][a-zA-Z0-9]*)*$" + -- | Regex matching a Hydra package name: hyphen-separated lowercase segments, each starting with a letter. regexPackageName :: String regexPackageName = "^[a-z][a-z0-9]*(-[a-z][a-z0-9]*)*$" + -- | Regex matching a PascalCase identifier: starts with an uppercase letter, then any letters or digits. regexPascalCase :: String regexPascalCase = "^[A-Z][a-zA-Z0-9]*$" + -- | A standard warning message for auto-generated files warningAutoGeneratedFile :: String warningAutoGeneratedFile = "Note: this is an automatically generated file. Do not edit." diff --git a/src/main/haskell/Hydra/Core.hs b/src/main/haskell/Hydra/Core.hs --- a/src/main/haskell/Hydra/Core.hs +++ b/src/main/haskell/Hydra/Core.hs @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Hydra's core data model, consisting of the fundamental hydra.core.Term type and all of its dependencies. module Hydra.Core where + import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.ByteString as B import qualified Data.Int as I import qualified Data.Map as M import qualified Data.Set as S + -- | A term together with an annotation data AnnotatedTerm = AnnotatedTerm { @@ -16,9 +19,13 @@ -- | The annotation as a single term. By convention this is a map term (Name -> Term) so that multiple independent annotations can coexist, but applications are free to use any term shape. annotatedTermAnnotation :: Term} deriving (Eq, Ord, Read, Show) + _AnnotatedTerm = Name "hydra.core.AnnotatedTerm" + _AnnotatedTerm_body = Name "body" + _AnnotatedTerm_annotation = Name "annotation" + -- | A type together with an annotation data AnnotatedType = AnnotatedType { @@ -27,9 +34,13 @@ -- | The annotation as a single term. By convention this is a map term (Name -> Term) so that multiple independent annotations can coexist, but applications are free to use any term shape. annotatedTypeAnnotation :: Term} deriving (Eq, Ord, Read, Show) + _AnnotatedType = Name "hydra.core.AnnotatedType" + _AnnotatedType_body = Name "body" + _AnnotatedType_annotation = Name "annotation" + -- | A term which applies a function to an argument data Application = Application { @@ -38,9 +49,13 @@ -- | The right-hand side of the application applicationArgument :: Term} deriving (Eq, Ord, Read, Show) + _Application = Name "hydra.core.Application" + _Application_function = Name "function" + _Application_argument = Name "argument" + -- | The type-level analog of an application term data ApplicationType = ApplicationType { @@ -49,9 +64,13 @@ -- | The right-hand side of the application applicationTypeArgument :: Type} deriving (Eq, Ord, Read, Show) + _ApplicationType = Name "hydra.core.ApplicationType" + _ApplicationType_function = Name "function" + _ApplicationType_argument = Name "argument" + -- | A field with an optional type scheme, used to bind variables to terms in a 'let' expression data Binding = Binding { @@ -62,10 +81,15 @@ -- | The optional type scheme of the bound term bindingTypeScheme :: (Maybe TypeScheme)} deriving (Eq, Ord, Read, Show) + _Binding = Name "hydra.core.Binding" + _Binding_name = Name "name" + _Binding_term = Name "term" + _Binding_typeScheme = Name "typeScheme" + -- | A single alternative of a case statement (union elimination): the variant being matched, together with the term that handles it. data CaseAlternative = CaseAlternative { @@ -74,9 +98,13 @@ -- | The handler applied to the matched variant's payload caseAlternativeHandler :: Term} deriving (Eq, Ord, Read, Show) + _CaseAlternative = Name "hydra.core.CaseAlternative" + _CaseAlternative_name = Name "name" + _CaseAlternative_handler = Name "handler" + -- | A union elimination; a case statement data CaseStatement = CaseStatement { @@ -87,10 +115,15 @@ -- | A list of case alternatives, one per union variant being handled caseStatementCases :: [CaseAlternative]} deriving (Eq, Ord, Read, Show) + _CaseStatement = Name "hydra.core.CaseStatement" + _CaseStatement_typeName = Name "typeName" + _CaseStatement_default = Name "default" + _CaseStatement_cases = Name "cases" + -- | A type which provides a choice between a 'left' type and a 'right' type data EitherType = EitherType { @@ -99,9 +132,13 @@ -- | The 'right' alternative eitherTypeRight :: Type} deriving (Eq, Ord, Read, Show) + _EitherType = Name "hydra.core.EitherType" + _EitherType_left = Name "left" + _EitherType_right = Name "right" + -- | A name/term pair data Field = Field { @@ -110,9 +147,13 @@ -- | The value of the field fieldTerm :: Term} deriving (Eq, Ord, Read, Show) + _Field = Name "hydra.core.Field" + _Field_name = Name "name" + _Field_term = Name "term" + -- | A name/type pair data FieldType = FieldType { @@ -121,9 +162,13 @@ -- | The type of the field fieldTypeType :: Type} deriving (Eq, Ord, Read, Show) + _FieldType = Name "hydra.core.FieldType" + _FieldType_name = Name "name" + _FieldType_type = Name "type" + -- | A floating-point type data FloatType = -- | A 32-bit floating-point type @@ -131,9 +176,13 @@ -- | A 64-bit floating-point type FloatTypeFloat64 deriving (Eq, Ord, Read, Show) + _FloatType = Name "hydra.core.FloatType" + _FloatType_float32 = Name "float32" + _FloatType_float64 = Name "float64" + -- | A floating-point literal value data FloatValue = -- | A 32-bit floating-point value @@ -141,9 +190,13 @@ -- | A 64-bit floating-point value FloatValueFloat64 Double deriving (Eq, Ord, Read, Show) + _FloatValue = Name "hydra.core.FloatValue" + _FloatValue_float32 = Name "float32" + _FloatValue_float64 = Name "float64" + -- | A universally quantified type; the System F equivalent of a type scheme, and the type-level equivalent of a lambda term. data ForallType = ForallType { @@ -152,9 +205,13 @@ -- | The body of the lambda forallTypeBody :: Type} deriving (Eq, Ord, Read, Show) + _ForallType = Name "hydra.core.ForallType" + _ForallType_parameter = Name "parameter" + _ForallType_body = Name "body" + -- | A function type, also known as an arrow type data FunctionType = FunctionType { @@ -163,9 +220,13 @@ -- | The codomain (output) type of the function functionTypeCodomain :: Type} deriving (Eq, Ord, Read, Show) + _FunctionType = Name "hydra.core.FunctionType" + _FunctionType_domain = Name "domain" + _FunctionType_codomain = Name "codomain" + -- | An instance of a union type; i.e. a string-indexed generalization of inl() or inr() data Injection = Injection { @@ -174,9 +235,13 @@ -- | The field being injected, including its name and value injectionField :: Field} deriving (Eq, Ord, Read, Show) + _Injection = Name "hydra.core.Injection" + _Injection_typeName = Name "typeName" + _Injection_field = Name "field" + -- | An integer type data IntegerType = -- | An arbitrary-precision integer type @@ -198,16 +263,27 @@ -- | A 64-bit unsigned integer type IntegerTypeUint64 deriving (Eq, Ord, Read, Show) + _IntegerType = Name "hydra.core.IntegerType" + _IntegerType_bigint = Name "bigint" + _IntegerType_int8 = Name "int8" + _IntegerType_int16 = Name "int16" + _IntegerType_int32 = Name "int32" + _IntegerType_int64 = Name "int64" + _IntegerType_uint8 = Name "uint8" + _IntegerType_uint16 = Name "uint16" + _IntegerType_uint32 = Name "uint32" + _IntegerType_uint64 = Name "uint64" + -- | An integer literal value data IntegerValue = -- | An arbitrary-precision integer value @@ -229,16 +305,27 @@ -- | A 64-bit unsigned integer value (unsigned long) IntegerValueUint64 Integer deriving (Eq, Ord, Read, Show) + _IntegerValue = Name "hydra.core.IntegerValue" + _IntegerValue_bigint = Name "bigint" + _IntegerValue_int8 = Name "int8" + _IntegerValue_int16 = Name "int16" + _IntegerValue_int32 = Name "int32" + _IntegerValue_int64 = Name "int64" + _IntegerValue_uint8 = Name "uint8" + _IntegerValue_uint16 = Name "uint16" + _IntegerValue_uint32 = Name "uint32" + _IntegerValue_uint64 = Name "uint64" + -- | A function abstraction (lambda) data Lambda = Lambda { @@ -249,10 +336,15 @@ -- | The body of the lambda lambdaBody :: Term} deriving (Eq, Ord, Read, Show) + _Lambda = Name "hydra.core.Lambda" + _Lambda_parameter = Name "parameter" + _Lambda_domain = Name "domain" + _Lambda_body = Name "body" + -- | A set of (possibly recursive) 'let' bindings together with a body in which they are bound data Let = Let { @@ -261,9 +353,13 @@ -- | The body term in which the variables are bound letBody :: Term} deriving (Eq, Ord, Read, Show) + _Let = Name "hydra.core.Let" + _Let_bindings = Name "bindings" + _Let_body = Name "body" + -- | A term constant; an instance of a literal type data Literal = -- | A binary literal @@ -279,13 +375,21 @@ -- | A string literal LiteralString String deriving (Eq, Ord, Read, Show) + _Literal = Name "hydra.core.Literal" + _Literal_binary = Name "binary" + _Literal_boolean = Name "boolean" + _Literal_decimal = Name "decimal" + _Literal_float = Name "float" + _Literal_integer = Name "integer" + _Literal_string = Name "string" + -- | Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants data LiteralType = -- | The type of a binary (byte string) value @@ -301,13 +405,21 @@ -- | The type of a string value LiteralTypeString deriving (Eq, Ord, Read, Show) + _LiteralType = Name "hydra.core.LiteralType" + _LiteralType_binary = Name "binary" + _LiteralType_boolean = Name "boolean" + _LiteralType_decimal = Name "decimal" + _LiteralType_float = Name "float" + _LiteralType_integer = Name "integer" + _LiteralType_string = Name "string" + -- | A map type data MapType = MapType { @@ -316,15 +428,21 @@ -- | The type of values in the map mapTypeValues :: Type} deriving (Eq, Ord, Read, Show) + _MapType = Name "hydra.core.MapType" + _MapType_keys = Name "keys" + _MapType_values = Name "values" + -- | A unique identifier in some context; a string-valued key newtype Name = Name { unName :: String} deriving (Eq, Ord, Read, Show) + _Name = Name "hydra.core.Name" + -- | A type which pairs a 'first' type and a 'second' type data PairType = PairType { @@ -333,9 +451,13 @@ -- | The second component of the pair pairTypeSecond :: Type} deriving (Eq, Ord, Read, Show) + _PairType = Name "hydra.core.PairType" + _PairType_first = Name "first" + _PairType_second = Name "second" + -- | A record elimination; a projection data Projection = Projection { @@ -344,9 +466,13 @@ -- | The name of the projected field projectionFieldName :: Name} deriving (Eq, Ord, Read, Show) + _Projection = Name "hydra.core.Projection" + _Projection_typeName = Name "typeName" + _Projection_fieldName = Name "fieldName" + -- | A record, or labeled tuple; a map of field names to terms data Record = Record { @@ -355,9 +481,13 @@ -- | The fields of the record, as a list of name/term pairs recordFields :: [Field]} deriving (Eq, Ord, Read, Show) + _Record = Name "hydra.core.Record" + _Record_typeName = Name "typeName" + _Record_fields = Name "fields" + -- | A data term data Term = -- | A term annotated with metadata @@ -403,34 +533,59 @@ -- | A wrapped term; an instance of a wrapper type (newtype) TermWrap WrappedTerm deriving (Eq, Ord, Read, Show) + _Term = Name "hydra.core.Term" + _Term_annotated = Name "annotated" + _Term_application = Name "application" + _Term_cases = Name "cases" + _Term_either = Name "either" + _Term_inject = Name "inject" + _Term_lambda = Name "lambda" + _Term_let = Name "let" + _Term_list = Name "list" + _Term_literal = Name "literal" + _Term_map = Name "map" + _Term_optional = Name "optional" + _Term_pair = Name "pair" + _Term_project = Name "project" + _Term_record = Name "record" + _Term_set = Name "set" + _Term_typeApplication = Name "typeApplication" + _Term_typeLambda = Name "typeLambda" + _Term_unit = Name "unit" + _Term_unwrap = Name "unwrap" + _Term_variable = Name "variable" + _Term_wrap = Name "wrap" + -- | A data type data Type = -- | An annotated type TypeAnnotated AnnotatedType | -- | A type application TypeApplication ApplicationType | + -- | An effectful computation which, when interpreted by a host application, may perform host interactions and produce a value of the given type + TypeEffect Type | -- | An either (sum) type TypeEither EitherType | -- | A universally quantified (polymorphic) type @@ -462,24 +617,45 @@ -- | A wrapped type (newtype). There is no corresponding `unwrap` variant at the type level: wrap is the introduction form, and a wrapper type's underlying body type is given by the `wrap` variant's argument. TypeWrap Type deriving (Eq, Ord, Read, Show) + _Type = Name "hydra.core.Type" + _Type_annotated = Name "annotated" + _Type_application = Name "application" + +_Type_effect = Name "effect" + _Type_either = Name "either" + _Type_forall = Name "forall" + _Type_function = Name "function" + _Type_list = Name "list" + _Type_literal = Name "literal" + _Type_map = Name "map" + _Type_optional = Name "optional" + _Type_pair = Name "pair" + _Type_record = Name "record" + _Type_set = Name "set" + _Type_union = Name "union" + _Type_unit = Name "unit" + _Type_variable = Name "variable" + _Type_void = Name "void" + _Type_wrap = Name "wrap" + -- | A term applied to a type; a type application. data TypeApplicationTerm = TypeApplicationTerm { @@ -488,16 +664,23 @@ -- | The type argument typeApplicationTermType :: Type} deriving (Eq, Ord, Read, Show) + _TypeApplicationTerm = Name "hydra.core.TypeApplicationTerm" + _TypeApplicationTerm_body = Name "body" + _TypeApplicationTerm_type = Name "type" + -- | A type class constraint on a type variable. Currently has only one variant, but designed to be forward-compatible with multi-parameter type classes and constraints on type expressions. data TypeClassConstraint = -- | A simple type class constraint, naming a single type class TypeClassConstraintSimple Name deriving (Eq, Ord, Read, Show) + _TypeClassConstraint = Name "hydra.core.TypeClassConstraint" + _TypeClassConstraint_simple = Name "simple" + -- | A System F type abstraction term data TypeLambda = TypeLambda { @@ -506,9 +689,13 @@ -- | The body of the abstraction typeLambdaBody :: Term} deriving (Eq, Ord, Read, Show) + _TypeLambda = Name "hydra.core.TypeLambda" + _TypeLambda_parameter = Name "parameter" + _TypeLambda_body = Name "body" + -- | A type expression together with free type variables occurring in the expression data TypeScheme = TypeScheme { @@ -519,18 +706,26 @@ -- | Optional constraints on type variables, including typeclass constraints. The map keys are type variable names. typeSchemeConstraints :: (Maybe (M.Map Name TypeVariableConstraints))} deriving (Eq, Ord, Read, Show) + _TypeScheme = Name "hydra.core.TypeScheme" + _TypeScheme_variables = Name "variables" + _TypeScheme_body = Name "body" + _TypeScheme_constraints = Name "constraints" + -- | Constraints associated with a type variable, including typeclass constraints data TypeVariableConstraints = TypeVariableConstraints { -- | The typeclass constraints on this type variable typeVariableConstraintsClasses :: [TypeClassConstraint]} deriving (Eq, Ord, Read, Show) + _TypeVariableConstraints = Name "hydra.core.TypeVariableConstraints" + _TypeVariableConstraints_classes = Name "classes" + -- | A term wrapped in a type name data WrappedTerm = WrappedTerm { @@ -539,6 +734,9 @@ -- | The wrapped term wrappedTermBody :: Term} deriving (Eq, Ord, Read, Show) + _WrappedTerm = Name "hydra.core.WrappedTerm" + _WrappedTerm_typeName = Name "typeName" + _WrappedTerm_body = Name "body" 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.ast module Hydra.Decode.Ast where + import qualified Hydra.Ast as Ast import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore @@ -9,14 +11,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.ast.Associativity associativity :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Associativity associativity cx raw = @@ -36,6 +39,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.BlockStyle blockStyle :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.BlockStyle blockStyle cx raw = @@ -59,6 +63,7 @@ Ast.blockStyleNewlineBeforeContent = field_newlineBeforeContent, Ast.blockStyleNewlineAfterContent = field_newlineAfterContent}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.BlockStyle")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.BracketExpr bracketExpr :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.BracketExpr bracketExpr cx raw = @@ -70,6 +75,7 @@ Ast.bracketExprEnclosed = field_enclosed, Ast.bracketExprStyle = field_style}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.BracketExpr")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Brackets brackets :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Brackets brackets cx raw = @@ -80,6 +86,7 @@ Ast.bracketsOpen = field_open, Ast.bracketsClose = field_close})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.Brackets")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Expr expr :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Expr expr cx raw = @@ -100,6 +107,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.IndentStyle indentStyle :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.IndentStyle indentStyle cx raw = @@ -129,6 +137,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.IndentedExpression indentedExpression :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.IndentedExpression indentedExpression cx raw = @@ -139,6 +148,7 @@ Ast.indentedExpressionStyle = field_style, Ast.indentedExpressionExpr = field_expr})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.IndentedExpression")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Op op :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Op op cx raw = @@ -151,6 +161,7 @@ Ast.opPrecedence = field_precedence, Ast.opAssociativity = field_associativity})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.Op")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.OpExpr opExpr :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.OpExpr opExpr cx raw = @@ -162,6 +173,7 @@ Ast.opExprLhs = field_lhs, Ast.opExprRhs = field_rhs}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.OpExpr")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Padding padding :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Padding padding cx raw = @@ -172,6 +184,7 @@ Ast.paddingLeft = field_left, Ast.paddingRight = field_right})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.Padding")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Precedence precedence :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Precedence precedence cx raw = @@ -184,6 +197,7 @@ _ -> Left (Errors.DecodingError "expected int32 literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.SeqExpr seqExpr :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.SeqExpr seqExpr cx raw = @@ -194,6 +208,7 @@ Ast.seqExprOp = field_op, Ast.seqExprElements = field_elements})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.ast.SeqExpr")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Symbol symbol :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Symbol symbol cx raw = @@ -204,6 +219,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.ast.Ws ws :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Ast.Ws ws cx raw = 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 @@ -1,26 +1,29 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.coders module Hydra.Decode.Coders where + import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Errors as DecodeErrors -import qualified Hydra.Decode.Typing as Typing +import qualified Hydra.Decode.File as File import qualified Hydra.Decode.Util as DecodeUtil import qualified Hydra.Decode.Variants as Variants 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.coders.CaseConventions caseConventions :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Coders.CaseConventions caseConventions cx raw = @@ -39,6 +42,7 @@ Coders.caseConventionsType = field_type, Coders.caseConventionsTypeVariable = field_typeVariable})))))))))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.coders.CaseConventions")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.coders.CoderDirection coderDirection :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Coders.CoderDirection coderDirection cx raw = @@ -56,6 +60,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.coders.LanguageFeature languageFeature :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Coders.LanguageFeature languageFeature cx raw = @@ -80,6 +85,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.coders.LanguageName languageName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Coders.LanguageName languageName cx raw = @@ -90,6 +96,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.coders.TraversalOrder traversalOrder :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Coders.TraversalOrder traversalOrder cx raw = 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 @@ -1,20 +1,23 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.core module Hydra.Decode.Core 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.core.AnnotatedTerm annotatedTerm :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.AnnotatedTerm annotatedTerm cx raw = @@ -25,6 +28,7 @@ Core.annotatedTermBody = field_body, Core.annotatedTermAnnotation = field_annotation})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.AnnotatedTerm")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.AnnotatedType annotatedType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.AnnotatedType annotatedType cx raw = @@ -35,6 +39,7 @@ Core.annotatedTypeBody = field_body, Core.annotatedTypeAnnotation = field_annotation})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.AnnotatedType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Application application :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Application application cx raw = @@ -45,6 +50,7 @@ Core.applicationFunction = field_function, Core.applicationArgument = field_argument})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Application")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.ApplicationType applicationType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.ApplicationType applicationType cx raw = @@ -55,6 +61,7 @@ Core.applicationTypeFunction = field_function, Core.applicationTypeArgument = field_argument})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.ApplicationType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Binding binding :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Binding binding cx raw = @@ -66,6 +73,7 @@ Core.bindingTerm = field_term, Core.bindingTypeScheme = field_typeScheme}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Binding")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.CaseAlternative caseAlternative :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.CaseAlternative caseAlternative cx raw = @@ -76,6 +84,7 @@ Core.caseAlternativeName = field_name, Core.caseAlternativeHandler = field_handler})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.CaseAlternative")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.CaseStatement caseStatement :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.CaseStatement caseStatement cx raw = @@ -87,6 +96,7 @@ Core.caseStatementDefault = field_default, Core.caseStatementCases = field_cases}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.CaseStatement")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.EitherType eitherType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.EitherType eitherType cx raw = @@ -97,6 +107,7 @@ Core.eitherTypeLeft = field_left, Core.eitherTypeRight = field_right})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.EitherType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Field field :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Field field cx raw = @@ -107,6 +118,7 @@ Core.fieldName = field_name, Core.fieldTerm = field_term})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Field")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.FieldType fieldType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.FieldType fieldType cx raw = @@ -117,6 +129,7 @@ Core.fieldTypeName = field_name, Core.fieldTypeType = field_type})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.FieldType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.FloatType floatType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.FloatType floatType cx raw = @@ -134,6 +147,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.FloatValue floatValue :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.FloatValue floatValue cx raw = @@ -167,6 +181,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.ForallType forallType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.ForallType forallType cx raw = @@ -177,6 +192,7 @@ Core.forallTypeParameter = field_parameter, Core.forallTypeBody = field_body})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.ForallType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.FunctionType functionType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.FunctionType functionType cx raw = @@ -187,6 +203,7 @@ Core.functionTypeDomain = field_domain, Core.functionTypeCodomain = field_codomain})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.FunctionType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Injection injection :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Injection injection cx raw = @@ -197,6 +214,7 @@ Core.injectionTypeName = field_typeName, Core.injectionField = field_field})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Injection")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.IntegerType integerType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.IntegerType integerType cx raw = @@ -221,6 +239,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.IntegerValue integerValue :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.IntegerValue integerValue cx raw = @@ -317,6 +336,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Lambda lambda :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Lambda lambda cx raw = @@ -328,6 +348,7 @@ Core.lambdaDomain = field_domain, Core.lambdaBody = field_body}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Lambda")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Let let_ :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Let let_ cx raw = @@ -338,6 +359,7 @@ Core.letBindings = field_bindings, Core.letBody = field_body})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Let")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Literal literal :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Literal literal cx raw = @@ -383,6 +405,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.LiteralType literalType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.LiteralType literalType cx raw = @@ -404,6 +427,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.MapType mapType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.MapType mapType cx raw = @@ -414,6 +438,7 @@ Core.mapTypeKeys = field_keys, Core.mapTypeValues = field_values})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.MapType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Name name :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Name name cx raw = @@ -424,6 +449,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.PairType pairType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.PairType pairType cx raw = @@ -434,6 +460,7 @@ Core.pairTypeFirst = field_first, Core.pairTypeSecond = field_second})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.PairType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Projection projection :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Projection projection cx raw = @@ -444,6 +471,7 @@ Core.projectionTypeName = field_typeName, Core.projectionFieldName = field_fieldName})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Projection")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Record record :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Record record cx raw = @@ -454,6 +482,7 @@ Core.recordTypeName = field_typeName, Core.recordFields = field_fields})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.Record")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Term term :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Term term cx raw = @@ -490,6 +519,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.Type type_ :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.Type type_ cx raw = @@ -502,6 +532,7 @@ Maps.fromList [ (Core.Name "annotated", (\input -> Eithers.map (\t -> Core.TypeAnnotated t) (annotatedType cx input))), (Core.Name "application", (\input -> Eithers.map (\t -> Core.TypeApplication t) (applicationType cx input))), + (Core.Name "effect", (\input -> Eithers.map (\t -> Core.TypeEffect t) (type_ cx input))), (Core.Name "either", (\input -> Eithers.map (\t -> Core.TypeEither t) (eitherType cx input))), (Core.Name "forall", (\input -> Eithers.map (\t -> Core.TypeForall t) (forallType cx input))), (Core.Name "function", (\input -> Eithers.map (\t -> Core.TypeFunction t) (functionType cx input))), @@ -522,6 +553,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.TypeApplicationTerm typeApplicationTerm :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.TypeApplicationTerm typeApplicationTerm cx raw = @@ -532,6 +564,7 @@ Core.typeApplicationTermBody = field_body, Core.typeApplicationTermType = field_type})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.TypeApplicationTerm")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.TypeClassConstraint typeClassConstraint :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.TypeClassConstraint typeClassConstraint cx raw = @@ -548,6 +581,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.TypeLambda typeLambda :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.TypeLambda typeLambda cx raw = @@ -558,6 +592,7 @@ Core.typeLambdaParameter = field_parameter, Core.typeLambdaBody = field_body})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.TypeLambda")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.TypeScheme typeScheme :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.TypeScheme typeScheme cx raw = @@ -569,6 +604,7 @@ Core.typeSchemeBody = field_body, Core.typeSchemeConstraints = field_constraints}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.TypeScheme")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.TypeVariableConstraints typeVariableConstraints :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.TypeVariableConstraints typeVariableConstraints cx raw = @@ -578,6 +614,7 @@ in (Eithers.bind (ExtractCore.requireField "classes" (ExtractCore.decodeList typeClassConstraint) fieldMap cx) (\field_classes -> Right (Core.TypeVariableConstraints { Core.typeVariableConstraintsClasses = field_classes}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.core.TypeVariableConstraints")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.core.WrappedTerm wrappedTerm :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Core.WrappedTerm wrappedTerm cx raw = diff --git a/src/main/haskell/Hydra/Decode/Docs.hs b/src/main/haskell/Hydra/Decode/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/Docs.hs @@ -0,0 +1,45 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.docs + +module Hydra.Decode.Docs where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Packaging as Packaging +import qualified Hydra.Docs as Docs +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.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.docs.DocSegment +docSegment :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Docs.DocSegment +docSegment 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 "ref", (\input -> Eithers.map (\t -> Docs.DocSegmentRef t) (Packaging.entityReference cx input))), + ( + Core.Name "text", + (\input -> Eithers.map (\t -> Docs.DocSegmentText t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + 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 [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.error.checking module Hydra.Decode.Error.Checking where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Paths as Paths @@ -12,14 +14,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.error.checking.CheckingError checkingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.CheckingError checkingError cx raw = @@ -72,6 +75,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.IncorrectUnificationError incorrectUnificationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.IncorrectUnificationError incorrectUnificationError cx raw = @@ -81,6 +85,7 @@ in (Eithers.bind (ExtractCore.requireField "substitution" Typing.typeSubst fieldMap cx) (\field_substitution -> Right (Checking.IncorrectUnificationError { Checking.incorrectUnificationErrorSubstitution = field_substitution}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.IncorrectUnificationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.NotAForallTypeError notAForallTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.NotAForallTypeError notAForallTypeError cx raw = @@ -91,6 +96,7 @@ Checking.notAForallTypeErrorType = field_type, Checking.notAForallTypeErrorTypeArguments = field_typeArguments})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.NotAForallTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.NotAFunctionTypeError notAFunctionTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.NotAFunctionTypeError notAFunctionTypeError cx raw = @@ -100,6 +106,7 @@ in (Eithers.bind (ExtractCore.requireField "type" DecodeCore.type_ fieldMap cx) (\field_type -> Right (Checking.NotAFunctionTypeError { Checking.notAFunctionTypeErrorType = field_type}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.NotAFunctionTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.OtherCheckingError otherCheckingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.OtherCheckingError otherCheckingError cx raw = @@ -114,6 +121,7 @@ Checking.otherCheckingErrorPath = field_path, Checking.otherCheckingErrorMessage = field_message})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.OtherCheckingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.TypeArityMismatchError typeArityMismatchError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.TypeArityMismatchError typeArityMismatchError cx raw = @@ -138,6 +146,7 @@ Checking.typeArityMismatchErrorActualArity = field_actualArity, Checking.typeArityMismatchErrorTypeArguments = field_typeArguments})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.TypeArityMismatchError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.TypeMismatchError typeMismatchError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.TypeMismatchError typeMismatchError cx raw = @@ -148,6 +157,7 @@ Checking.typeMismatchErrorExpectedType = field_expectedType, Checking.typeMismatchErrorActualType = field_actualType})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.TypeMismatchError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UnboundTypeVariablesError unboundTypeVariablesError cx raw = @@ -158,6 +168,7 @@ Checking.unboundTypeVariablesErrorVariables = field_variables, Checking.unboundTypeVariablesErrorType = field_type})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UnboundTypeVariablesError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingError cx raw = @@ -168,6 +179,7 @@ Checking.undefinedTermVariableCheckingErrorPath = field_path, Checking.undefinedTermVariableCheckingErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UndefinedTermVariableCheckingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UnequalTypesError unequalTypesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UnequalTypesError unequalTypesError cx raw = @@ -182,6 +194,7 @@ Checking.unequalTypesErrorTypes = field_types, Checking.unequalTypesErrorDescription = field_description})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UnequalTypesError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UnsupportedTermVariantError unsupportedTermVariantError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UnsupportedTermVariantError unsupportedTermVariantError cx raw = @@ -191,6 +204,7 @@ in (Eithers.bind (ExtractCore.requireField "termVariant" Variants.termVariant fieldMap cx) (\field_termVariant -> Right (Checking.UnsupportedTermVariantError { Checking.unsupportedTermVariantErrorTermVariant = field_termVariant}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UnsupportedTermVariantError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UntypedLambdaError untypedLambdaError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UntypedLambdaError untypedLambdaError cx raw = @@ -200,6 +214,7 @@ in (Right (Checking.UntypedLambdaError { })) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UntypedLambdaError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UntypedLetBindingError untypedLetBindingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UntypedLetBindingError untypedLetBindingError cx raw = @@ -209,6 +224,7 @@ in (Eithers.bind (ExtractCore.requireField "binding" DecodeCore.binding fieldMap cx) (\field_binding -> Right (Checking.UntypedLetBindingError { Checking.untypedLetBindingErrorBinding = field_binding}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.checking.UntypedLetBindingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Checking.UntypedTermVariableCheckingError untypedTermVariableCheckingError cx raw = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.error.core module Hydra.Decode.Error.Core where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Paths as Paths @@ -11,14 +13,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.error.core.ConstantConditionError constantConditionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.ConstantConditionError constantConditionError cx raw = @@ -33,6 +36,7 @@ ErrorCore.constantConditionErrorLocation = field_location, ErrorCore.constantConditionErrorValue = field_value})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.ConstantConditionError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.DuplicateBindingError duplicateBindingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.DuplicateBindingError duplicateBindingError cx raw = @@ -43,6 +47,7 @@ ErrorCore.duplicateBindingErrorLocation = field_location, ErrorCore.duplicateBindingErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.DuplicateBindingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.DuplicateFieldError duplicateFieldError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.DuplicateFieldError duplicateFieldError cx raw = @@ -53,6 +58,7 @@ ErrorCore.duplicateFieldErrorLocation = field_location, ErrorCore.duplicateFieldErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.DuplicateFieldError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesError cx raw = @@ -63,6 +69,7 @@ ErrorCore.duplicateRecordTypeFieldNamesErrorLocation = field_location, ErrorCore.duplicateRecordTypeFieldNamesErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.DuplicateRecordTypeFieldNamesError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesError cx raw = @@ -73,6 +80,7 @@ ErrorCore.duplicateUnionTypeFieldNamesErrorLocation = field_location, ErrorCore.duplicateUnionTypeFieldNamesErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.DuplicateUnionTypeFieldNamesError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyCaseStatementError emptyCaseStatementError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyCaseStatementError emptyCaseStatementError cx raw = @@ -83,6 +91,7 @@ ErrorCore.emptyCaseStatementErrorLocation = field_location, ErrorCore.emptyCaseStatementErrorTypeName = field_typeName})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyCaseStatementError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyLetBindingsError emptyLetBindingsError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyLetBindingsError emptyLetBindingsError cx raw = @@ -92,6 +101,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyLetBindingsError { ErrorCore.emptyLetBindingsErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyLetBindingsError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyRecordTypeError emptyRecordTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyRecordTypeError emptyRecordTypeError cx raw = @@ -101,6 +111,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyRecordTypeError { ErrorCore.emptyRecordTypeErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyRecordTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyTermAnnotationError emptyTermAnnotationError cx raw = @@ -110,6 +121,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyTermAnnotationError { ErrorCore.emptyTermAnnotationErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyTermAnnotationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyTypeAnnotationError emptyTypeAnnotationError cx raw = @@ -119,6 +131,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyTypeAnnotationError { ErrorCore.emptyTypeAnnotationErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyTypeAnnotationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyTypeNameInTermError emptyTypeNameInTermError cx raw = @@ -128,6 +141,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyTypeNameInTermError { ErrorCore.emptyTypeNameInTermErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyTypeNameInTermError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.EmptyUnionTypeError emptyUnionTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.EmptyUnionTypeError emptyUnionTypeError cx raw = @@ -137,6 +151,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.EmptyUnionTypeError { ErrorCore.emptyUnionTypeErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.EmptyUnionTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidForallParameterNameError invalidForallParameterNameError cx raw = @@ -147,6 +162,7 @@ ErrorCore.invalidForallParameterNameErrorLocation = field_location, ErrorCore.invalidForallParameterNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.InvalidForallParameterNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidLambdaParameterNameError invalidLambdaParameterNameError cx raw = @@ -157,6 +173,7 @@ ErrorCore.invalidLambdaParameterNameErrorLocation = field_location, ErrorCore.invalidLambdaParameterNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.InvalidLambdaParameterNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidLetBindingNameError invalidLetBindingNameError cx raw = @@ -167,6 +184,7 @@ ErrorCore.invalidLetBindingNameErrorLocation = field_location, ErrorCore.invalidLetBindingNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.InvalidLetBindingNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidLiteralError invalidLiteralError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidLiteralError invalidLiteralError cx raw = @@ -185,6 +203,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidTermError invalidTermError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidTermError invalidTermError cx raw = @@ -266,6 +285,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidTypeError invalidTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidTypeError invalidTypeError cx raw = @@ -323,6 +343,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameError cx raw = @@ -333,6 +354,7 @@ ErrorCore.invalidTypeLambdaParameterNameErrorLocation = field_location, ErrorCore.invalidTypeLambdaParameterNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.InvalidTypeLambdaParameterNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameError cx raw = @@ -343,6 +365,7 @@ ErrorCore.invalidTypeSchemeVariableNameErrorLocation = field_location, ErrorCore.invalidTypeSchemeVariableNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.InvalidTypeSchemeVariableNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.LiteralTypeMismatchError literalTypeMismatchError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.LiteralTypeMismatchError literalTypeMismatchError cx raw = @@ -353,6 +376,7 @@ ErrorCore.literalTypeMismatchErrorExpectedType = field_expectedType, 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.NestedTermAnnotationError nestedTermAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NestedTermAnnotationError nestedTermAnnotationError cx raw = @@ -362,6 +386,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.NestedTermAnnotationError { ErrorCore.nestedTermAnnotationErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.NestedTermAnnotationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.NestedTypeAnnotationError nestedTypeAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NestedTypeAnnotationError nestedTypeAnnotationError cx raw = @@ -371,6 +396,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.NestedTypeAnnotationError { ErrorCore.nestedTypeAnnotationErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.NestedTypeAnnotationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeError cx raw = @@ -381,6 +407,7 @@ ErrorCore.nonComparableMapKeyTypeErrorLocation = field_location, ErrorCore.nonComparableMapKeyTypeErrorKeyType = field_keyType})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.NonComparableMapKeyTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NonComparableSetElementTypeError nonComparableSetElementTypeError cx raw = @@ -391,6 +418,7 @@ ErrorCore.nonComparableSetElementTypeErrorLocation = field_location, ErrorCore.nonComparableSetElementTypeErrorElementType = field_elementType})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.NonComparableSetElementTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.RedundantWrapUnwrapError redundantWrapUnwrapError cx raw = @@ -401,6 +429,7 @@ ErrorCore.redundantWrapUnwrapErrorLocation = field_location, ErrorCore.redundantWrapUnwrapErrorTypeName = field_typeName})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.RedundantWrapUnwrapError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.SelfApplicationError selfApplicationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.SelfApplicationError selfApplicationError cx raw = @@ -411,6 +440,7 @@ ErrorCore.selfApplicationErrorLocation = field_location, ErrorCore.selfApplicationErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.SelfApplicationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.SingleVariantUnionError singleVariantUnionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.SingleVariantUnionError singleVariantUnionError cx raw = @@ -421,6 +451,7 @@ ErrorCore.singleVariantUnionErrorLocation = field_location, ErrorCore.singleVariantUnionErrorFieldName = field_fieldName})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.SingleVariantUnionError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.TermVariableShadowingError termVariableShadowingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.TermVariableShadowingError termVariableShadowingError cx raw = @@ -431,6 +462,7 @@ ErrorCore.termVariableShadowingErrorLocation = field_location, ErrorCore.termVariableShadowingErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.TermVariableShadowingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.TypeVariableShadowingInForallError typeVariableShadowingInForallError cx raw = @@ -441,6 +473,7 @@ ErrorCore.typeVariableShadowingInForallErrorLocation = field_location, ErrorCore.typeVariableShadowingInForallErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.TypeVariableShadowingInForallError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaError cx raw = @@ -451,6 +484,7 @@ ErrorCore.typeVariableShadowingInTypeLambdaErrorLocation = field_location, ErrorCore.typeVariableShadowingInTypeLambdaErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.TypeVariableShadowingInTypeLambdaError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedFieldError undefinedFieldError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedFieldError undefinedFieldError cx raw = @@ -461,6 +495,7 @@ ErrorCore.undefinedFieldErrorFieldName = field_fieldName, ErrorCore.undefinedFieldErrorTypeName = field_typeName})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedFieldError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedTermVariableError undefinedTermVariableError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedTermVariableError undefinedTermVariableError cx raw = @@ -471,6 +506,7 @@ ErrorCore.undefinedTermVariableErrorLocation = field_location, ErrorCore.undefinedTermVariableErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedTermVariableError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedTypeVariableError undefinedTypeVariableError cx raw = @@ -481,6 +517,7 @@ ErrorCore.undefinedTypeVariableErrorLocation = field_location, ErrorCore.undefinedTypeVariableErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedTypeVariableError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeError cx raw = @@ -491,6 +528,7 @@ ErrorCore.undefinedTypeVariableInBindingTypeErrorLocation = field_location, ErrorCore.undefinedTypeVariableInBindingTypeErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedTypeVariableInBindingTypeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainError cx raw = @@ -501,6 +539,7 @@ ErrorCore.undefinedTypeVariableInLambdaDomainErrorLocation = field_location, ErrorCore.undefinedTypeVariableInLambdaDomainErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedTypeVariableInLambdaDomainError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationError cx raw = @@ -511,6 +550,7 @@ ErrorCore.undefinedTypeVariableInTypeApplicationErrorLocation = field_location, ErrorCore.undefinedTypeVariableInTypeApplicationErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndefinedTypeVariableInTypeApplicationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnexpectedTermVariantError unexpectedTermVariantError cx raw = @@ -521,6 +561,7 @@ ErrorCore.unexpectedTermVariantErrorExpectedVariant = field_expectedVariant, ErrorCore.unexpectedTermVariantErrorActualTerm = field_actualTerm})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnexpectedTermVariantError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnexpectedTypeVariantError unexpectedTypeVariantError cx raw = @@ -531,6 +572,7 @@ 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.UnknownPrimitiveNameError unknownPrimitiveNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnknownPrimitiveNameError unknownPrimitiveNameError cx raw = @@ -541,6 +583,7 @@ ErrorCore.unknownPrimitiveNameErrorLocation = field_location, ErrorCore.unknownPrimitiveNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnknownPrimitiveNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError cx raw = @@ -550,6 +593,7 @@ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Right (ErrorCore.UnnecessaryIdentityApplicationError { ErrorCore.unnecessaryIdentityApplicationErrorLocation = field_location}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnnecessaryIdentityApplicationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.UntypedTermVariableError untypedTermVariableError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UntypedTermVariableError untypedTermVariableError cx raw = @@ -560,6 +604,7 @@ ErrorCore.untypedTermVariableErrorLocation = field_location, ErrorCore.untypedTermVariableErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UntypedTermVariableError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.VoidInNonBottomPositionError voidInNonBottomPositionError cx raw = diff --git a/src/main/haskell/Hydra/Decode/Error/File.hs b/src/main/haskell/Hydra/Decode/Error/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/Error/File.hs @@ -0,0 +1,58 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.error.file + +module Hydra.Decode.Error.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.File as DecodeFile +import qualified Hydra.Error.File as ErrorFile +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.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.error.file.FileError +fileError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorFile.FileError +fileError 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 "alreadyExists", + (\input -> Eithers.map (\t -> ErrorFile.FileErrorAlreadyExists t) (DecodeFile.filePath cx input))), + ( + Core.Name "invalidPath", + (\input -> Eithers.map (\t -> ErrorFile.FileErrorInvalidPath t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + (Core.Name "notFound", (\input -> Eithers.map (\t -> ErrorFile.FileErrorNotFound t) (DecodeFile.filePath cx input))), + ( + Core.Name "other", + (\input -> Eithers.map (\t -> ErrorFile.FileErrorOther t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + ( + 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 [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.error.packaging module Hydra.Decode.Error.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Packaging as DecodePackaging @@ -11,14 +13,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.error.packaging.ConflictingModuleNameError conflictingModuleNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.ConflictingModuleNameError conflictingModuleNameError cx raw = @@ -29,6 +32,7 @@ ErrorPackaging.conflictingModuleNameErrorFirst = field_first, ErrorPackaging.conflictingModuleNameErrorSecond = field_second})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.ConflictingModuleNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.ConflictingVariantNameError conflictingVariantNameError cx raw = @@ -41,6 +45,7 @@ ErrorPackaging.conflictingVariantNameErrorVariantName = field_variantName, ErrorPackaging.conflictingVariantNameErrorConflictingName = field_conflictingName})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.ConflictingVariantNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.DefinitionNotInModuleNameError definitionNotInModuleNameError cx raw = @@ -51,6 +56,7 @@ ErrorPackaging.definitionNotInModuleNameErrorModuleName = field_moduleName, ErrorPackaging.definitionNotInModuleNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.DefinitionNotInModuleNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.DefinitionsOutOfOrderError definitionsOutOfOrderError cx raw = @@ -62,6 +68,7 @@ ErrorPackaging.definitionsOutOfOrderErrorPrecedingName = field_precedingName, ErrorPackaging.definitionsOutOfOrderErrorFollowingName = field_followingName}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.DefinitionsOutOfOrderError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.DuplicateDefinitionNameError duplicateDefinitionNameError cx raw = @@ -72,6 +79,7 @@ ErrorPackaging.duplicateDefinitionNameErrorModuleName = field_moduleName, ErrorPackaging.duplicateDefinitionNameErrorName = field_name})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.DuplicateDefinitionNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.DuplicateModuleNameError duplicateModuleNameError cx raw = @@ -81,6 +89,7 @@ in (Eithers.bind (ExtractCore.requireField "moduleName" DecodePackaging.moduleName fieldMap cx) (\field_moduleName -> Right (ErrorPackaging.DuplicateModuleNameError { ErrorPackaging.duplicateModuleNameErrorModuleName = field_moduleName}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.DuplicateModuleNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.InvalidDefinitionNameError invalidDefinitionNameError cx raw = @@ -92,6 +101,7 @@ ErrorPackaging.invalidDefinitionNameErrorName = field_name, ErrorPackaging.invalidDefinitionNameErrorExpectedConvention = field_expectedConvention}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.InvalidDefinitionNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.InvalidModuleError invalidModuleError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.InvalidModuleError invalidModuleError cx raw = @@ -128,6 +138,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.InvalidModuleNameConventionError invalidModuleNameConventionError cx raw = @@ -137,6 +148,7 @@ in (Eithers.bind (ExtractCore.requireField "moduleName" DecodePackaging.moduleName fieldMap cx) (\field_moduleName -> Right (ErrorPackaging.InvalidModuleNameConventionError { ErrorPackaging.invalidModuleNameConventionErrorModuleName = field_moduleName}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.InvalidModuleNameConventionError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.InvalidPackageError invalidPackageError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.InvalidPackageError invalidPackageError cx raw = @@ -164,6 +176,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.InvalidPackageNameError invalidPackageNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.InvalidPackageNameError invalidPackageNameError cx raw = @@ -173,6 +186,7 @@ in (Eithers.bind (ExtractCore.requireField "packageName" DecodePackaging.packageName fieldMap cx) (\field_packageName -> Right (ErrorPackaging.InvalidPackageNameError { ErrorPackaging.invalidPackageNameErrorPackageName = field_packageName}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.packaging.InvalidPackageNameError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.error.packaging.MissingDocumentationError missingDocumentationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorPackaging.MissingDocumentationError missingDocumentationError cx raw = diff --git a/src/main/haskell/Hydra/Decode/Error/System.hs b/src/main/haskell/Hydra/Decode/Error/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/Error/System.hs @@ -0,0 +1,54 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.error.system + +module Hydra.Decode.Error.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.File as File +import qualified Hydra.Error.System as System +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.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.error.system.SystemError +systemError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError System.SystemError +systemError 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 "commandNotFound", + (\input -> Eithers.map (\t -> System.SystemErrorCommandNotFound t) (File.filePath cx input))), + ( + Core.Name "permissionDenied", + (\input -> Eithers.map (\t -> System.SystemErrorPermissionDenied t) (File.filePath cx input))), + ( + Core.Name "invalidWorkingDirectory", + (\input -> Eithers.map (\t -> System.SystemErrorInvalidWorkingDirectory t) (File.filePath cx input))), + (Core.Name "interrupted", (\input -> Eithers.map (\t -> System.SystemErrorInterrupted) (ExtractCore.decodeUnit cx input))), + ( + Core.Name "other", + (\input -> Eithers.map (\t -> System.SystemErrorOther t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + 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 [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.errors module Hydra.Decode.Errors where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Error.Checking as Checking @@ -13,14 +15,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.errors.DecodingError decodingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.DecodingError decodingError cx raw = @@ -31,9 +34,11 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.EmptyListError emptyListError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError () emptyListError cx t = ExtractCore.decodeUnit cx t + -- | Decoder for hydra.errors.Error error :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.Error error cx raw = @@ -80,6 +85,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.ExtractionError extractionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.ExtractionError extractionError cx raw = @@ -114,6 +120,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.InferenceError inferenceError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.InferenceError inferenceError cx raw = @@ -134,6 +141,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.MultipleBindingsError multipleBindingsError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.MultipleBindingsError multipleBindingsError cx raw = @@ -143,6 +151,7 @@ in (Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Right (Errors.MultipleBindingsError { Errors.multipleBindingsErrorName = field_name}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.MultipleBindingsError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.MultipleFieldsError multipleFieldsError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.MultipleFieldsError multipleFieldsError cx raw = @@ -152,6 +161,7 @@ in (Eithers.bind (ExtractCore.requireField "fieldName" DecodeCore.name fieldMap cx) (\field_fieldName -> Right (Errors.MultipleFieldsError { Errors.multipleFieldsErrorFieldName = field_fieldName}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.MultipleFieldsError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.NoMatchingFieldError noMatchingFieldError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.NoMatchingFieldError noMatchingFieldError cx raw = @@ -161,6 +171,7 @@ in (Eithers.bind (ExtractCore.requireField "fieldName" DecodeCore.name fieldMap cx) (\field_fieldName -> Right (Errors.NoMatchingFieldError { Errors.noMatchingFieldErrorFieldName = field_fieldName}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.NoMatchingFieldError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.NoSuchBindingError noSuchBindingError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.NoSuchBindingError noSuchBindingError cx raw = @@ -170,6 +181,7 @@ in (Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Right (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = field_name}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.NoSuchBindingError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.NoSuchPrimitiveError noSuchPrimitiveError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.NoSuchPrimitiveError noSuchPrimitiveError cx raw = @@ -179,9 +191,11 @@ in (Eithers.bind (ExtractCore.requireField "name" DecodeCore.name fieldMap cx) (\field_name -> Right (Errors.NoSuchPrimitiveError { Errors.noSuchPrimitiveErrorName = field_name}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.NoSuchPrimitiveError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.NotEnoughCasesError notEnoughCasesError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError () notEnoughCasesError cx t = ExtractCore.decodeUnit cx t + -- | Decoder for hydra.errors.OtherError otherError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.OtherError otherError cx raw = @@ -192,6 +206,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.OtherInferenceError otherInferenceError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.OtherInferenceError otherInferenceError cx raw = @@ -206,6 +221,7 @@ Errors.otherInferenceErrorPath = field_path, Errors.otherInferenceErrorMessage = field_message})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.OtherInferenceError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.OtherResolutionError otherResolutionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.OtherResolutionError otherResolutionError cx raw = @@ -216,6 +232,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.ResolutionError resolutionError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.ResolutionError resolutionError cx raw = @@ -244,6 +261,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.UnexpectedShapeError unexpectedShapeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.UnexpectedShapeError unexpectedShapeError cx raw = @@ -262,6 +280,7 @@ Errors.unexpectedShapeErrorExpected = field_expected, Errors.unexpectedShapeErrorActual = field_actual})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.UnexpectedShapeError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.UnificationError unificationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.UnificationError unificationError cx raw = @@ -277,6 +296,7 @@ Errors.unificationErrorRightType = field_rightType, Errors.unificationErrorMessage = field_message}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.errors.UnificationError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.errors.UnificationInferenceError unificationInferenceError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Errors.UnificationInferenceError unificationInferenceError cx raw = diff --git a/src/main/haskell/Hydra/Decode/File.hs b/src/main/haskell/Hydra/Decode/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/File.hs @@ -0,0 +1,87 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.file + +module Hydra.Decode.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Decode.Time as Time +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.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.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.file.FileExtension +fileExtension :: Graph.Graph -> Core.Term -> Either Errors.DecodingError File.FileExtension +fileExtension cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermWrap v0 -> Eithers.map (\b -> File.FileExtension b) ((\raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) + _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.file.FilePath +filePath :: Graph.Graph -> Core.Term -> Either Errors.DecodingError File.FilePath +filePath cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermWrap v0 -> Eithers.map (\b -> File.FilePath b) ((\raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) + _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.file.FileStatus +fileStatus :: Graph.Graph -> Core.Term -> Either Errors.DecodingError File.FileStatus +fileStatus cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "fileType" fileType fieldMap cx) (\field_fileType -> Eithers.bind (ExtractCore.requireField "size" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt64 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int64 value") + _ -> Left (Errors.DecodingError "expected int64 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_size -> Eithers.bind (ExtractCore.requireField "modificationTime" Time.timespec fieldMap cx) (\field_modificationTime -> Eithers.bind (ExtractCore.requireField "accessTime" (ExtractCore.decodeMaybe Time.timespec) fieldMap cx) (\field_accessTime -> Eithers.bind (ExtractCore.requireField "statusChangeTime" (ExtractCore.decodeMaybe Time.timespec) fieldMap cx) (\field_statusChangeTime -> Right (File.FileStatus { + File.fileStatusFileType = field_fileType, + File.fileStatusSize = field_size, + File.fileStatusModificationTime = field_modificationTime, + File.fileStatusAccessTime = field_accessTime, + File.fileStatusStatusChangeTime = field_statusChangeTime}))))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.file.FileStatus")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.file.FileType +fileType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError File.FileType +fileType 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 "block", (\input -> Eithers.map (\t -> File.FileTypeBlock) (ExtractCore.decodeUnit cx input))), + (Core.Name "character", (\input -> Eithers.map (\t -> File.FileTypeCharacter) (ExtractCore.decodeUnit cx input))), + (Core.Name "directory", (\input -> Eithers.map (\t -> File.FileTypeDirectory) (ExtractCore.decodeUnit cx input))), + (Core.Name "fifo", (\input -> Eithers.map (\t -> File.FileTypeFifo) (ExtractCore.decodeUnit cx input))), + (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 [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.json.model module Hydra.Decode.Json.Model where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Errors as Errors @@ -9,14 +11,15 @@ import qualified Hydra.Graph as Graph import qualified Hydra.Json.Model as Model import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.json.model.Value value :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Model.Value value cx raw = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.packaging module Hydra.Decode.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Typing as Typing @@ -9,15 +11,16 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Packaging as Packaging 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.packaging.Definition definition :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.Definition definition cx raw = @@ -28,14 +31,15 @@ fterm = Core.fieldTerm field variantMap = Maps.fromList [ + (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))), - (Core.Name "primitive", (\input -> Eithers.map (\t -> Packaging.DefinitionPrimitive t) (primitiveDefinition 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 [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.DefinitionReference definitionReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.DefinitionReference definitionReference cx raw = @@ -46,16 +50,37 @@ fterm = Core.fieldTerm field variantMap = Maps.fromList [ - (Core.Name "type", (\input -> Eithers.map (\t -> Packaging.DefinitionReferenceType t) (DecodeCore.name cx input))), - (Core.Name "term", (\input -> Eithers.map (\t -> Packaging.DefinitionReferenceTerm t) (DecodeCore.name cx input))), ( Core.Name "primitive", - (\input -> Eithers.map (\t -> Packaging.DefinitionReferencePrimitive t) (DecodeCore.name cx input)))] + (\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 [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.packaging.DependencyScope +dependencyScope :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.DependencyScope +dependencyScope 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 "api", (\input -> Eithers.map (\t -> Packaging.DependencyScopeApi) (ExtractCore.decodeUnit cx input))), + (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 [ + "no such field ", + (Core.unName fname), + " in union"]))) (\f -> f fterm)) + _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.EntityMetadata entityMetadata :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.EntityMetadata entityMetadata cx raw = @@ -76,6 +101,7 @@ Packaging.entityMetadataSeeAlso = field_seeAlso, Packaging.entityMetadataLifecycle = field_lifecycle})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.EntityMetadata")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.EntityReference entityReference :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.EntityReference entityReference cx raw = @@ -86,16 +112,31 @@ fterm = Core.fieldTerm field variantMap = Maps.fromList [ - (Core.Name "package", (\input -> Eithers.map (\t -> Packaging.EntityReferencePackage t) (packageName cx input))), - (Core.Name "module", (\input -> Eithers.map (\t -> Packaging.EntityReferenceModule t) (moduleName cx input))), ( Core.Name "definition", - (\input -> Eithers.map (\t -> Packaging.EntityReferenceDefinition t) (definitionReference cx input)))] + (\input -> Eithers.map (\t -> Packaging.EntityReferenceDefinition t) (definitionReference cx input))), + (Core.Name "module", (\input -> Eithers.map (\t -> Packaging.EntityReferenceModule t) (moduleName cx input))), + (Core.Name "package", (\input -> Eithers.map (\t -> Packaging.EntityReferencePackage t) (packageName cx input))), + ( + Core.Name "termExpr", + (\input -> Eithers.map (\t -> Packaging.EntityReferenceTermExpr t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx input)))), + ( + Core.Name "typeExpr", + (\input -> Eithers.map (\t -> Packaging.EntityReferenceTypeExpr t) (Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + 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 [ "no such field ", (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.LifecycleInfo lifecycleInfo :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.LifecycleInfo lifecycleInfo cx raw = @@ -106,6 +147,7 @@ Packaging.lifecycleInfoAvailableSince = field_availableSince, Packaging.lifecycleInfoDeprecatedSince = field_deprecatedSince})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.LifecycleInfo")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.Module module_ :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.Module module_ cx raw = @@ -118,6 +160,7 @@ Packaging.moduleDependencies = field_dependencies, Packaging.moduleDefinitions = field_definitions})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.Module")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.ModuleDependency moduleDependency :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.ModuleDependency moduleDependency cx raw = @@ -128,6 +171,7 @@ Packaging.moduleDependencyModule = field_module, Packaging.moduleDependencyPackage = field_package})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.ModuleDependency")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.ModuleName moduleName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.ModuleName moduleName cx raw = @@ -138,6 +182,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.Package package :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.Package package cx raw = @@ -150,16 +195,19 @@ Packaging.packageDependencies = field_dependencies, Packaging.packageModules = field_modules})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.Package")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.PackageDependency packageDependency :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.PackageDependency packageDependency cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermRecord v0 -> let fieldMap = ExtractCore.toFieldMap v0 - in (Eithers.bind (ExtractCore.requireField "name" packageName fieldMap cx) (\field_name -> Eithers.bind (ExtractCore.requireField "version" versionSpecifier fieldMap cx) (\field_version -> Right (Packaging.PackageDependency { + in (Eithers.bind (ExtractCore.requireField "name" packageName fieldMap cx) (\field_name -> Eithers.bind (ExtractCore.requireField "version" versionSpecifier fieldMap cx) (\field_version -> Eithers.bind (ExtractCore.requireField "scope" (ExtractCore.decodeMaybe dependencyScope) fieldMap cx) (\field_scope -> Right (Packaging.PackageDependency { Packaging.packageDependencyName = field_name, - Packaging.packageDependencyVersion = field_version})))) + Packaging.packageDependencyVersion = field_version, + Packaging.packageDependencyScope = field_scope}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.PackageDependency")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.PackageName packageName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.PackageName packageName cx raw = @@ -170,6 +218,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.PrimitiveDefinition primitiveDefinition :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.PrimitiveDefinition primitiveDefinition cx raw = @@ -192,6 +241,7 @@ Packaging.primitiveDefinitionIsTotal = field_isTotal, Packaging.primitiveDefinitionDefaultImplementation = field_defaultImplementation})))))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.PrimitiveDefinition")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.TermDefinition termDefinition :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.TermDefinition termDefinition cx raw = @@ -204,6 +254,7 @@ Packaging.termDefinitionSignature = field_signature, Packaging.termDefinitionBody = field_body})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.TermDefinition")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.TypeDefinition typeDefinition :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.TypeDefinition typeDefinition cx raw = @@ -215,6 +266,7 @@ Packaging.typeDefinitionMetadata = field_metadata, Packaging.typeDefinitionBody = field_body}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.TypeDefinition")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.Version version :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.Version version cx raw = @@ -225,6 +277,18 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.packaging.VersionRange +versionRange :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.VersionRange +versionRange cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "lowerInclusive" (ExtractCore.decodeMaybe version) fieldMap cx) (\field_lowerInclusive -> Eithers.bind (ExtractCore.requireField "upperExclusive" (ExtractCore.decodeMaybe version) fieldMap cx) (\field_upperExclusive -> Right (Packaging.VersionRange { + Packaging.versionRangeLowerInclusive = field_lowerInclusive, + Packaging.versionRangeUpperExclusive = field_upperExclusive})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.packaging.VersionRange")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.packaging.VersionSpecifier versionSpecifier :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Packaging.VersionSpecifier versionSpecifier cx raw = @@ -235,7 +299,10 @@ fterm = Core.fieldTerm field variantMap = Maps.fromList [ - (Core.Name "any", (\input -> Eithers.map (\t -> Packaging.VersionSpecifierAny) (ExtractCore.decodeUnit cx input)))] + (Core.Name "any", (\input -> Eithers.map (\t -> Packaging.VersionSpecifierAny) (ExtractCore.decodeUnit cx input))), + (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 [ "no such field ", (Core.unName fname), 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 @@ -1,22 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.parsing module Hydra.Decode.Parsing where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Parsing as Parsing 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.parsing.ParseError parseError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Parsing.ParseError parseError cx raw = @@ -35,6 +38,7 @@ Parsing.parseErrorMessage = field_message, Parsing.parseErrorRemainder = field_remainder})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.parsing.ParseError")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.parsing.ParseResult parseResult :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Parsing.ParseResult a) parseResult a cx raw = @@ -52,6 +56,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.parsing.ParseSuccess parseSuccess :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Parsing.ParseSuccess a) parseSuccess a cx raw = 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 @@ -1,22 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.paths module Hydra.Decode.Paths where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Paths as Paths 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.paths.SubtermEdge subtermEdge :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermEdge subtermEdge cx raw = @@ -28,6 +31,7 @@ Paths.subtermEdgePath = field_path, Paths.subtermEdgeTarget = field_target}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtermEdge")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtermGraph subtermGraph :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermGraph subtermGraph cx raw = @@ -38,6 +42,7 @@ Paths.subtermGraphNodes = field_nodes, Paths.subtermGraphEdges = field_edges})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtermGraph")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtermNode subtermNode :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermNode subtermNode cx raw = @@ -57,12 +62,14 @@ Paths.subtermNodeLabel = field_label, Paths.subtermNodeId = field_id}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtermNode")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtermPath subtermPath :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermPath subtermPath cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Paths.SubtermPath b) (ExtractCore.decodeList subtermStep cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtermStep subtermStep :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtermStep subtermStep cx raw = @@ -156,6 +163,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtypeEdge subtypeEdge :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeEdge subtypeEdge cx raw = @@ -167,6 +175,7 @@ Paths.subtypeEdgePath = field_path, Paths.subtypeEdgeTarget = field_target}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtypeEdge")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtypeGraph subtypeGraph :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeGraph subtypeGraph cx raw = @@ -177,6 +186,7 @@ Paths.subtypeGraphNodes = field_nodes, Paths.subtypeGraphEdges = field_edges})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtypeGraph")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtypeNode subtypeNode :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeNode subtypeNode cx raw = @@ -196,12 +206,14 @@ Paths.subtypeNodeLabel = field_label, Paths.subtypeNodeId = field_id}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.paths.SubtypeNode")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtypePath subtypePath :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypePath subtypePath cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Paths.SubtypePath b) (ExtractCore.decodeList subtypeStep cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.paths.SubtypeStep subtypeStep :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Paths.SubtypeStep subtypeStep cx raw = 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 @@ -1,22 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.query module Hydra.Decode.Query where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Query as Query 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.query.ComparisonConstraint comparisonConstraint :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.ComparisonConstraint comparisonConstraint cx raw = @@ -48,6 +51,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Edge edge :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Edge edge cx raw = @@ -59,6 +63,7 @@ Query.edgeOut = field_out, Query.edgeIn = field_in}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.Edge")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.GraphPattern graphPattern :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.GraphPattern graphPattern cx raw = @@ -69,6 +74,7 @@ Query.graphPatternGraph = field_graph, Query.graphPatternPatterns = field_patterns})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.GraphPattern")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Node node :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Node node cx raw = @@ -87,6 +93,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Path path :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Path path cx raw = @@ -105,6 +112,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.PathEquation pathEquation :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.PathEquation pathEquation cx raw = @@ -115,6 +123,7 @@ Query.pathEquationLeft = field_left, Query.pathEquationRight = field_right})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.PathEquation")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Pattern pattern :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Pattern pattern cx raw = @@ -139,6 +148,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.PatternImplication patternImplication :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.PatternImplication patternImplication cx raw = @@ -149,6 +159,7 @@ Query.patternImplicationAntecedent = field_antecedent, Query.patternImplicationConsequent = field_consequent})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.PatternImplication")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Query query :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Query query cx raw = @@ -159,6 +170,7 @@ Query.queryVariables = field_variables, Query.queryPatterns = field_patterns})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.Query")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Range range :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Range range cx raw = @@ -181,6 +193,7 @@ Query.rangeMin = field_min, Query.rangeMax = field_max})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.Range")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.RegexQuantifier regexQuantifier :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.RegexQuantifier regexQuantifier cx raw = @@ -221,6 +234,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.RegexSequence regexSequence :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.RegexSequence regexSequence cx raw = @@ -231,6 +245,7 @@ Query.regexSequencePath = field_path, Query.regexSequenceQuantifier = field_quantifier})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.RegexSequence")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Step step :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Step step cx raw = @@ -249,6 +264,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.TriplePattern triplePattern :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.TriplePattern triplePattern cx raw = @@ -260,6 +276,7 @@ Query.triplePatternPredicate = field_predicate, Query.triplePatternObject = field_object}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.query.TriplePattern")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.query.Variable variable :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Query.Variable variable cx raw = diff --git a/src/main/haskell/Hydra/Decode/Relational.hs b/src/main/haskell/Hydra/Decode/Relational.hs --- a/src/main/haskell/Hydra/Decode/Relational.hs +++ b/src/main/haskell/Hydra/Decode/Relational.hs @@ -1,19 +1,22 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.relational module Hydra.Decode.Relational where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Relational as Relational 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.relational.ColumnName columnName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Relational.ColumnName columnName cx raw = @@ -24,6 +27,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.ColumnSchema columnSchema :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.ColumnSchema t) columnSchema t cx raw = @@ -34,6 +38,7 @@ Relational.columnSchemaName = field_name, Relational.columnSchemaDomain = field_domain})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.relational.ColumnSchema")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.ForeignKey foreignKey :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Relational.ForeignKey foreignKey cx raw = @@ -44,18 +49,21 @@ Relational.foreignKeyForeignRelation = field_foreignRelation, Relational.foreignKeyKeys = field_keys})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.relational.ForeignKey")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.PrimaryKey primaryKey :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Relational.PrimaryKey primaryKey cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Relational.PrimaryKey b) (ExtractCore.decodeList columnName cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.Relation relation :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Relation v) relation v cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Relational.Relation b) (ExtractCore.decodeList (row v) cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.RelationName relationName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Relational.RelationName relationName cx raw = @@ -66,6 +74,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.RelationSchema relationSchema :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.RelationSchema t) relationSchema t cx raw = @@ -78,12 +87,14 @@ Relational.relationSchemaPrimaryKeys = field_primaryKeys, Relational.relationSchemaForeignKeys = field_foreignKeys})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.relational.RelationSchema")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.Relationship relationship :: Ord v => ((Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Relationship v)) relationship v cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Relational.Relationship b) (ExtractCore.decodeSet (ExtractCore.decodeMap columnName v) cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.relational.Row row :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Relational.Row v) row v cx raw = diff --git a/src/main/haskell/Hydra/Decode/System.hs b/src/main/haskell/Hydra/Decode/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/System.hs @@ -0,0 +1,84 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.system + +module Hydra.Decode.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Decode.File as File +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.Rewriting as Rewriting +import qualified Hydra.System as System +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.system.Command +command :: Graph.Graph -> Core.Term -> Either Errors.DecodingError System.Command +command cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "program" File.filePath fieldMap cx) (\field_program -> Eithers.bind (ExtractCore.requireField "arguments" (ExtractCore.decodeList (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2))) fieldMap cx) (\field_arguments -> Eithers.bind (ExtractCore.requireField "workingDirectory" (ExtractCore.decodeMaybe File.filePath) fieldMap cx) (\field_workingDirectory -> Eithers.bind (ExtractCore.requireField "environment" (ExtractCore.decodeMaybe (ExtractCore.decodeMap environmentVariable (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)))) fieldMap cx) (\field_environment -> Right (System.Command { + System.commandProgram = field_program, + System.commandArguments = field_arguments, + System.commandWorkingDirectory = field_workingDirectory, + System.commandEnvironment = field_environment})))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.system.Command")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.system.EnvironmentVariable +environmentVariable :: Graph.Graph -> Core.Term -> Either Errors.DecodingError System.EnvironmentVariable +environmentVariable cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermWrap v0 -> Eithers.map (\b -> System.EnvironmentVariable b) ((\raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralString v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected string literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) + _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.system.ProcessResult +processResult :: Graph.Graph -> Core.Term -> Either Errors.DecodingError System.ProcessResult +processResult cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "exitCode" statusCode fieldMap cx) (\field_exitCode -> Eithers.bind (ExtractCore.requireField "stdout" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralBinary v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected binary literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_stdout -> Eithers.bind (ExtractCore.requireField "stderr" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralBinary v2 -> Right v2 + _ -> Left (Errors.DecodingError "expected binary literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_stderr -> Right (System.ProcessResult { + System.processResultExitCode = field_exitCode, + System.processResultStdout = field_stdout, + System.processResultStderr = field_stderr}))))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.system.ProcessResult")) (ExtractCore.stripWithDecodingError cx raw) + +-- | Decoder for hydra.system.StatusCode +statusCode :: Graph.Graph -> Core.Term -> Either Errors.DecodingError System.StatusCode +statusCode cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermWrap v0 -> Eithers.map (\b -> System.StatusCode b) ((\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 cx raw2)) (Core.wrappedTermBody v0)) + _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) diff --git a/src/main/haskell/Hydra/Decode/Tabular.hs b/src/main/haskell/Hydra/Decode/Tabular.hs --- a/src/main/haskell/Hydra/Decode/Tabular.hs +++ b/src/main/haskell/Hydra/Decode/Tabular.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.tabular module Hydra.Decode.Tabular where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Relational as Relational @@ -9,12 +11,13 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Tabular as Tabular 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.tabular.ColumnType columnType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Tabular.ColumnType columnType cx raw = @@ -25,12 +28,14 @@ Tabular.columnTypeName = field_name, Tabular.columnTypeType = field_type})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.tabular.ColumnType")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.tabular.DataRow dataRow :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Tabular.DataRow v) dataRow v cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Tabular.DataRow b) (ExtractCore.decodeList (ExtractCore.decodeMaybe v) cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.tabular.HeaderRow headerRow :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Tabular.HeaderRow headerRow cx raw = @@ -41,6 +46,7 @@ _ -> Left (Errors.DecodingError "expected string literal") _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.tabular.Table table :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError v) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Tabular.Table v) table v cx raw = @@ -51,6 +57,7 @@ Tabular.tableHeader = field_header, Tabular.tableData = field_data})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.tabular.Table")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.tabular.TableType tableType :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Tabular.TableType tableType cx raw = diff --git a/src/main/haskell/Hydra/Decode/Testing.hs b/src/main/haskell/Hydra/Decode/Testing.hs --- a/src/main/haskell/Hydra/Decode/Testing.hs +++ b/src/main/haskell/Hydra/Decode/Testing.hs @@ -1,19 +1,22 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.testing module Hydra.Decode.Testing where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Testing as Testing 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.testing.Tag tag :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Testing.Tag tag cx raw = diff --git a/src/main/haskell/Hydra/Decode/Time.hs b/src/main/haskell/Hydra/Decode/Time.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Decode/Time.hs @@ -0,0 +1,41 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term decoders for hydra.time + +module Hydra.Decode.Time where + +import qualified Hydra.Core as Core +import qualified Hydra.Decode.Core as DecodeCore +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.Rewriting as Rewriting +import qualified Hydra.Time as Time +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.time.Timespec +timespec :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Time.Timespec +timespec cx raw = + Eithers.either (\err -> Left err) (\stripped -> case stripped of + Core.TermRecord v0 -> + let fieldMap = ExtractCore.toFieldMap v0 + in (Eithers.bind (ExtractCore.requireField "seconds" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueInt64 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected int64 value") + _ -> Left (Errors.DecodingError "expected int64 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_seconds -> Eithers.bind (ExtractCore.requireField "nanoseconds" (\cx2 -> \raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of + Core.TermLiteral v1 -> case v1 of + Core.LiteralInteger v2 -> case v2 of + Core.IntegerValueUint32 v3 -> Right v3 + _ -> Left (Errors.DecodingError "expected uint32 value") + _ -> Left (Errors.DecodingError "expected uint32 literal") + _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_nanoseconds -> Right (Time.Timespec { + Time.timespecSeconds = field_seconds, + Time.timespecNanoseconds = field_nanoseconds})))) + _ -> Left (Errors.DecodingError "expected a record of type hydra.time.Timespec")) (ExtractCore.stripWithDecodingError cx raw) diff --git a/src/main/haskell/Hydra/Decode/Topology.hs b/src/main/haskell/Hydra/Decode/Topology.hs --- a/src/main/haskell/Hydra/Decode/Topology.hs +++ b/src/main/haskell/Hydra/Decode/Topology.hs @@ -1,23 +1,27 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.topology module Hydra.Decode.Topology where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Topology as Topology import qualified Hydra.Util as Util import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Decoder for hydra.topology.Graph graph :: Graph.Graph -> Core.Term -> Either Errors.DecodingError (M.Map Topology.Vertex [Topology.Vertex]) graph = ExtractCore.decodeMap vertex (ExtractCore.decodeList vertex) + -- | Decoder for hydra.topology.TarjanState tarjanState :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Topology.TarjanState tarjanState cx raw = @@ -50,6 +54,7 @@ Topology.tarjanStateOnStack = field_onStack, Topology.tarjanStateSccs = field_sccs})))))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.topology.TarjanState")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.topology.Vertex vertex :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Int vertex cx raw = 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 @@ -1,19 +1,22 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.typed module Hydra.Decode.Typed where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Typed as Typed 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.typed.TypedBinding typedBinding :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typed.TypedBinding a) typedBinding a cx raw = @@ -24,12 +27,14 @@ Typed.typedBindingName = field_name, Typed.typedBindingTerm = field_term})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typed.TypedBinding")) (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 = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Typed.TypedTerm b) (DecodeCore.term cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typed.TypedTermDefinition typedTermDefinition :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError a) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typed.TypedTermDefinition a) typedTermDefinition a cx raw = diff --git a/src/main/haskell/Hydra/Decode/Typing.hs b/src/main/haskell/Hydra/Decode/Typing.hs --- a/src/main/haskell/Hydra/Decode/Typing.hs +++ b/src/main/haskell/Hydra/Decode/Typing.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.typing module Hydra.Decode.Typing where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Paths as Paths @@ -9,12 +11,13 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Typing as Typing 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.typing.FunctionStructure functionStructure :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError env) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Typing.FunctionStructure env) functionStructure env cx raw = @@ -30,6 +33,7 @@ Typing.functionStructureCodomain = field_codomain, Typing.functionStructureEnvironment = field_environment}))))))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.FunctionStructure")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.InferenceContext inferenceContext :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.InferenceContext inferenceContext cx raw = @@ -46,6 +50,7 @@ Typing.inferenceContextFreshTypeVariableCount = field_freshTypeVariableCount, Typing.inferenceContextTrace = field_trace})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.InferenceContext")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.InferenceResult inferenceResult :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.InferenceResult inferenceResult cx raw = @@ -59,6 +64,7 @@ Typing.inferenceResultClassConstraints = field_classConstraints, Typing.inferenceResultContext = field_context}))))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.InferenceResult")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.Parameter parameter :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.Parameter parameter cx raw = @@ -79,6 +85,7 @@ Typing.parameterType = field_type, Typing.parameterIsLazy = field_isLazy})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.Parameter")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.Result result :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.Result result cx raw = @@ -93,6 +100,7 @@ Typing.resultDescription = field_description, Typing.resultType = field_type})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.Result")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TermSignature termSignature :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TermSignature termSignature cx raw = @@ -104,12 +112,14 @@ Typing.termSignatureParameters = field_parameters, Typing.termSignatureResult = field_result}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.TermSignature")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TermSubst termSubst :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TermSubst termSubst cx raw = Eithers.either (\err -> Left err) (\stripped -> case stripped of Core.TermWrap v0 -> Eithers.map (\b -> Typing.TermSubst b) (ExtractCore.decodeMap DecodeCore.name DecodeCore.term cx (Core.wrappedTermBody v0)) _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TypeClass typeClass :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TypeClass typeClass cx raw = @@ -123,6 +133,7 @@ _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx2 raw2)) fieldMap cx) (\field_description -> Right (Typing.TypeClass { Typing.typeClassDescription = field_description}))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.TypeClass")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TypeConstraint typeConstraint :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TypeConstraint typeConstraint cx raw = @@ -138,6 +149,7 @@ Typing.typeConstraintRight = field_right, Typing.typeConstraintComment = field_comment}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.TypeConstraint")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TypeParameter typeParameter :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TypeParameter typeParameter cx raw = @@ -148,6 +160,7 @@ Typing.typeParameterName = field_name, Typing.typeParameterConstraints = field_constraints})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.typing.TypeParameter")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.typing.TypeSubst typeSubst :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Typing.TypeSubst typeSubst 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.util module Hydra.Decode.Util where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Packaging as Packaging @@ -9,14 +11,15 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.util.CaseConvention caseConvention :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Util.CaseConvention caseConvention cx raw = @@ -36,6 +39,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.util.Comparison comparison :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Util.Comparison comparison cx raw = @@ -54,16 +58,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) --- | Decoder for hydra.util.FileExtension -fileExtension :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Util.FileExtension -fileExtension cx raw = - Eithers.either (\err -> Left err) (\stripped -> case stripped of - Core.TermWrap v0 -> Eithers.map (\b -> Util.FileExtension b) ((\raw2 -> Eithers.either (\err -> Left err) (\stripped2 -> case stripped2 of - Core.TermLiteral v1 -> case v1 of - Core.LiteralString v2 -> Right v2 - _ -> Left (Errors.DecodingError "expected string literal") - _ -> Left (Errors.DecodingError "expected literal")) (ExtractCore.stripWithDecodingError cx raw2)) (Core.wrappedTermBody v0)) - _ -> Left (Errors.DecodingError "expected wrapped type")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.util.ModuleNames moduleNames :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError n) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Util.ModuleNames n) moduleNames n cx raw = @@ -74,6 +69,7 @@ Util.moduleNamesFocus = field_focus, Util.moduleNamesMapping = field_mapping})))) _ -> Left (Errors.DecodingError "expected a record of type hydra.util.ModuleNames")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.util.Precision precision :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Util.Precision precision cx raw = @@ -99,6 +95,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.util.QualifiedName qualifiedName :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Util.QualifiedName qualifiedName cx raw = diff --git a/src/main/haskell/Hydra/Decode/Validation.hs b/src/main/haskell/Hydra/Decode/Validation.hs --- a/src/main/haskell/Hydra/Decode/Validation.hs +++ b/src/main/haskell/Hydra/Decode/Validation.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.validation module Hydra.Decode.Validation where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore import qualified Hydra.Decode.Error.Core as ErrorCore @@ -9,12 +11,13 @@ import qualified Hydra.Extract.Core as ExtractCore import qualified Hydra.Graph as Graph import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers import qualified Hydra.Rewriting as Rewriting import qualified Hydra.Util as Util import qualified Hydra.Validation as Validation import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Decoder for hydra.validation.ValidationProfile validationProfile :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Validation.ValidationProfile validationProfile cx raw = @@ -39,6 +42,7 @@ Validation.validationProfileMaxErrors = field_maxErrors, Validation.validationProfileMaxWarnings = field_maxWarnings})))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.validation.ValidationProfile")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.validation.ValidationResult validationResult :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError e) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Validation.ValidationResult e) validationResult e cx raw = 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 @@ -1,22 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.variants module Hydra.Decode.Variants where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Rewriting as Rewriting 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 + -- | Decoder for hydra.variants.LiteralVariant literalVariant :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Variants.LiteralVariant literalVariant cx raw = @@ -38,6 +41,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.variants.TermVariant termVariant :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Variants.TermVariant termVariant cx raw = @@ -78,6 +82,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.variants.TypeVariant typeVariant :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Variants.TypeVariant typeVariant cx raw = @@ -92,6 +97,7 @@ ( Core.Name "application", (\input -> Eithers.map (\t -> Variants.TypeVariantApplication) (ExtractCore.decodeUnit cx input))), + (Core.Name "effect", (\input -> Eithers.map (\t -> Variants.TypeVariantEffect) (ExtractCore.decodeUnit cx input))), (Core.Name "either", (\input -> Eithers.map (\t -> Variants.TypeVariantEither) (ExtractCore.decodeUnit cx input))), (Core.Name "forall", (\input -> Eithers.map (\t -> Variants.TypeVariantForall) (ExtractCore.decodeUnit cx input))), (Core.Name "function", (\input -> Eithers.map (\t -> Variants.TypeVariantFunction) (ExtractCore.decodeUnit cx input))), 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 @@ -1,22 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term decoders for hydra.yaml.model module Hydra.Decode.Yaml.Model where + import qualified Hydra.Core as Core import qualified Hydra.Decode.Core as DecodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Rewriting as Rewriting import qualified Hydra.Util as Util import qualified Hydra.Yaml.Model as Model import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Decoder for hydra.yaml.model.Node node :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Model.Node node cx raw = @@ -35,6 +38,7 @@ (Core.unName fname), " in union"]))) (\f -> f fterm)) _ -> Left (Errors.DecodingError "expected union")) (ExtractCore.stripWithDecodingError cx raw) + -- | Decoder for hydra.yaml.model.Scalar scalar :: Graph.Graph -> Core.Term -> Either Errors.DecodingError Model.Scalar scalar cx raw = 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 @@ -1,30 +1,36 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for generating term decoders from type modules module Hydra.Decoding 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.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -35,8 +41,10 @@ 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 +import qualified Hydra.Time as Time import qualified Hydra.Topology as Topology import qualified Hydra.Typed as Typed import qualified Hydra.Typing as Typing @@ -45,6 +53,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Collect forall type variable names from a type collectForallVariables :: Core.Type -> [Core.Name] collectForallVariables typ = @@ -52,12 +61,14 @@ Core.TypeAnnotated v0 -> collectForallVariables (Core.annotatedTypeBody v0) Core.TypeForall v0 -> Lists.cons (Core.forallTypeParameter v0) (collectForallVariables (Core.forallTypeBody v0)) _ -> [] + -- | Collect type variables needing Ord constraints (from Map key and Set element types) collectOrdConstrainedVariables :: Core.Type -> [Core.Name] collectOrdConstrainedVariables typ = case typ of Core.TypeAnnotated v0 -> collectOrdConstrainedVariables (Core.annotatedTypeBody v0) Core.TypeApplication v0 -> Lists.concat2 (collectOrdConstrainedVariables (Core.applicationTypeFunction v0)) (collectOrdConstrainedVariables (Core.applicationTypeArgument v0)) + Core.TypeEffect v0 -> collectOrdConstrainedVariables v0 Core.TypeEither v0 -> Lists.concat2 (collectOrdConstrainedVariables (Core.eitherTypeLeft v0)) (collectOrdConstrainedVariables (Core.eitherTypeRight v0)) Core.TypeForall v0 -> collectOrdConstrainedVariables (Core.forallTypeBody v0) Core.TypeList v0 -> collectOrdConstrainedVariables v0 @@ -72,15 +83,18 @@ Core.TypeUnion v0 -> Lists.concat (Lists.map (\ft -> collectOrdConstrainedVariables (Core.fieldTypeType ft)) v0) Core.TypeWrap v0 -> collectOrdConstrainedVariables v0 _ -> [] + -- | Collect type variable names from a type (forall parameters only) collectTypeVariables :: Core.Type -> [Core.Name] collectTypeVariables typ = collectForallVariables typ + -- | Collect all type variable names from a type expression collectTypeVariablesFromType :: Core.Type -> [Core.Name] collectTypeVariablesFromType typ = case typ of Core.TypeAnnotated v0 -> collectTypeVariablesFromType (Core.annotatedTypeBody v0) Core.TypeApplication v0 -> Lists.concat2 (collectTypeVariablesFromType (Core.applicationTypeFunction v0)) (collectTypeVariablesFromType (Core.applicationTypeArgument v0)) + Core.TypeEffect v0 -> collectTypeVariablesFromType v0 Core.TypeEither v0 -> Lists.concat2 (collectTypeVariablesFromType (Core.eitherTypeLeft v0)) (collectTypeVariablesFromType (Core.eitherTypeRight v0)) Core.TypeForall v0 -> collectTypeVariablesFromType (Core.forallTypeBody v0) Core.TypeList v0 -> collectTypeVariablesFromType v0 @@ -94,6 +108,7 @@ v0] Core.TypeWrap v0 -> collectTypeVariablesFromType v0 _ -> [] + -- | Transform a type binding into a decoder binding decodeBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.DecodingError Core.Binding decodeBinding cx graph b = @@ -108,6 +123,7 @@ Core.bindingName = (decodeBindingName (Core.bindingName b)), Core.bindingTerm = (Annotations.setTermDescription (Just description) rawBody), Core.bindingTypeScheme = (Just (decoderTypeSchemeNamed (Core.bindingName b) typ))}))) + -- | Generate a binding name for a decoder function from a type name decodeBindingName :: Core.Name -> Core.Name decodeBindingName n = @@ -121,6 +137,7 @@ "hydra", "decode"] (Lists.concat2 tail [ localPart]))))))) + -- | Generate a decoder for an Either type decodeEitherType :: Core.EitherType -> Core.Term decodeEitherType et = @@ -136,6 +153,7 @@ Core.typeApplicationTermType = (decoderFullResultType (Core.eitherTypeRight et))})), Core.applicationArgument = leftDecoder})), Core.applicationArgument = rightDecoder})) + -- | Generate a decoder for a polymorphic (forall) type decodeForallType :: Core.ForallType -> Core.Term decodeForallType ft = @@ -149,6 +167,7 @@ Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), Core.eitherTypeRight = (Core.TypeVariable (Core.forallTypeParameter ft))}))}))}))), Core.lambdaBody = (decodeType (Core.forallTypeBody ft))}) + -- | Generate a decoder for a list type decodeListType :: Core.Type -> Core.Term decodeListType elemType = @@ -159,6 +178,7 @@ Core.typeApplicationTermBody = (Core.TermVariable (Core.Name "hydra.extract.core.decodeList")), Core.typeApplicationTermType = (decoderFullResultType elemType)})), Core.applicationArgument = elemDecoder})) + -- | Generate a decoder for a literal type decodeLiteralType :: Core.LiteralType -> Core.Term decodeLiteralType lt = @@ -1458,6 +1478,7 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.core.stripWithDecodingError")), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "raw"))}))}))}))}) + -- | Generate a decoder for a map type decodeMapType :: Core.MapType -> Core.Term decodeMapType mt = @@ -1473,6 +1494,7 @@ Core.typeApplicationTermType = (decoderFullResultType (Core.mapTypeValues mt))})), Core.applicationArgument = keyDecoder})), Core.applicationArgument = valDecoder})) + -- | Generate a decoder for an optional type decodeMaybeType :: Core.Type -> Core.Term decodeMaybeType elemType = @@ -1483,6 +1505,7 @@ Core.typeApplicationTermBody = (Core.TermVariable (Core.Name "hydra.extract.core.decodeMaybe")), Core.typeApplicationTermType = (decoderFullResultType elemType)})), Core.applicationArgument = elemDecoder})) + -- | Transform a type module into a decoder module decodeModule :: t0 -> Graph.Graph -> Packaging.Module -> Either Errors.Error (Maybe Packaging.Module) decodeModule cx graph mod = @@ -1526,6 +1549,7 @@ Packaging.termDefinitionMetadata = Nothing, Packaging.termDefinitionSignature = (Optionals.map Scoping.typeSchemeToTermSignature (Core.bindingTypeScheme b)), Packaging.termDefinitionBody = (Core.bindingTerm b)})) decodedBindings)})))))) + -- | Generate a decoder module name from a source module name decodeModuleName :: Packaging.ModuleName -> Packaging.ModuleName decodeModuleName ns = @@ -1535,6 +1559,7 @@ in (Optionals.cases (Lists.uncons parts) fallback (\uc -> Packaging.ModuleName (Strings.cat [ "hydra.decode.", (Strings.intercalate "." (Pairs.second uc))]))) + -- | Generate a decoder for a pair type decodePairType :: Core.PairType -> Core.Term decodePairType pt = @@ -1550,9 +1575,11 @@ Core.typeApplicationTermType = (decoderFullResultType (Core.pairTypeSecond pt))})), Core.applicationArgument = firstDecoder})), Core.applicationArgument = secondDecoder})) + -- | Generate a decoder for a record type decodeRecordType :: [Core.FieldType] -> Core.Term decodeRecordType rt = decodeRecordTypeImpl (Core.Name "unknown") rt (Core.TypeVariable (Core.Name "unknown")) + -- | Generate a decoder for a record type with a type name. rtype is the fully-applied result type (e.g. Table) used for the record's body annotations. (#476) decodeRecordTypeImpl :: Core.Name -> [Core.FieldType] -> Core.Type -> Core.Term decodeRecordTypeImpl tname rt rtype = @@ -1672,9 +1699,11 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.core.stripWithDecodingError")), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "raw"))}))}))}))})) + -- | Generate a decoder for a record type with element name decodeRecordTypeNamed :: Core.Name -> [Core.FieldType] -> Core.Type -> Core.Term decodeRecordTypeNamed ename rt rtype = decodeRecordTypeImpl ename rt rtype + -- | Generate a decoder for a set type decodeSetType :: Core.Type -> Core.Term decodeSetType elemType = @@ -1685,6 +1714,7 @@ Core.typeApplicationTermBody = (Core.TermVariable (Core.Name "hydra.extract.core.decodeSet")), Core.typeApplicationTermType = (decoderFullResultType elemType)})), Core.applicationArgument = elemDecoder})) + -- | Generate a decoder term for a Type decodeType :: Core.Type -> Core.Term decodeType typ = @@ -1720,6 +1750,7 @@ Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString "unsupported type variant"))})))), Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError"))})), Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))}))}) + -- | Generate a decoder term for a Type, with element name for nominal types. rtype is the FULLY-APPLIED result type for nominal bodies (e.g. DataRow for forall v. wrap...), so the body's intermediate type annotations carry the type parameters rather than a bare nominal name — otherwise Java/Scala coders emit raw types that fail to compile against the parameterized signature. (#476) decodeTypeNamed :: Core.Name -> Core.Type -> Core.Type -> Core.Term decodeTypeNamed ename typ rtype = @@ -1764,9 +1795,11 @@ Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString "unsupported type variant"))})))), Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError"))})), Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))}))}) + -- | Generate a decoder for a union type decodeUnionType :: [Core.FieldType] -> Core.Term decodeUnionType rt = decodeUnionTypeNamed (Core.Name "unknown") rt (Core.TypeVariable (Core.Name "unknown")) + -- | Generate a decoder for a union type with the given element name. rtype is the fully-applied result type (e.g. Foo) used for body annotations. (#476) decodeUnionTypeNamed :: Core.Name -> [Core.FieldType] -> Core.Type -> Core.Term decodeUnionTypeNamed ename rt rtype = @@ -1956,6 +1989,7 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.core.stripWithDecodingError")), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "raw"))}))}))}))})) + -- | Generate a decoder for the unit type decodeUnitType :: Core.Term decodeUnitType = @@ -1970,9 +2004,11 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.core.decodeUnit")), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "t"))}))}))}) + -- | Generate a decoder for a wrapped type decodeWrappedType :: Core.Type -> Core.Term decodeWrappedType wt = decodeWrappedTypeNamed (Core.Name "unknown") wt (Core.TypeVariable (Core.Name "unknown")) + -- | Generate a decoder for a wrapped type with the given element name. rtype is the fully-applied result type (e.g. DataRow) used for body annotations. (#476) decodeWrappedTypeNamed :: Core.Name -> Core.Type -> Core.Type -> Core.Term decodeWrappedTypeNamed ename wt rtype = @@ -2054,6 +2090,7 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.extract.core.stripWithDecodingError")), Core.applicationArgument = (Core.TermVariable (Core.Name "cx"))})), Core.applicationArgument = (Core.TermVariable (Core.Name "raw"))}))}))}))})) + -- | Get full result type for decoder decoderFullResultType :: Core.Type -> Core.Type decoderFullResultType typ = @@ -2062,6 +2099,7 @@ Core.TypeApplication v0 -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (decoderFullResultType (Core.applicationTypeFunction v0)), Core.applicationTypeArgument = (Core.applicationTypeArgument v0)}) + Core.TypeEffect v0 -> Core.TypeEffect (decoderFullResultType v0) Core.TypeEither v0 -> Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (decoderFullResultType (Core.eitherTypeLeft v0)), Core.eitherTypeRight = (decoderFullResultType (Core.eitherTypeRight v0))}) @@ -2085,6 +2123,7 @@ Core.TypeVoid -> Core.TypeVoid Core.TypeWrap v0 -> decoderFullResultType v0 _ -> Core.TypeVariable (Core.Name "hydra.core.Term") + -- | Get full result type for decoder with element name decoderFullResultTypeNamed :: Core.Name -> Core.Type -> Core.Type decoderFullResultTypeNamed ename typ = @@ -2099,6 +2138,7 @@ Core.TypeApplication v0 -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (decoderFullResultType (Core.applicationTypeFunction v0)), Core.applicationTypeArgument = (Core.applicationTypeArgument v0)}) + Core.TypeEffect v0 -> Core.TypeEffect (decoderFullResultType v0) Core.TypeEither v0 -> Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (decoderFullResultType (Core.eitherTypeLeft v0)), Core.eitherTypeRight = (decoderFullResultType (Core.eitherTypeRight v0))}) @@ -2116,6 +2156,7 @@ Core.TypeVariable v0 -> Core.TypeVariable v0 Core.TypeVoid -> Core.TypeVoid _ -> Core.TypeVariable (Core.Name "hydra.core.Term") + -- | Compute the result type name for a decoder decoderResultType :: Core.Type -> Core.Name decoderResultType typ = @@ -2128,6 +2169,7 @@ Core.TypeUnion _ -> Core.Name "hydra.core.Term" Core.TypeWrap _ -> Core.Name "hydra.core.Term" _ -> Core.Name "hydra.core.Term" + -- | Build decoder function type decoderType :: Core.Type -> Core.Type decoderType typ = @@ -2142,6 +2184,7 @@ Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), Core.eitherTypeRight = resultType}))}))}) in (prependForallDecoders baseType typ) + -- | Build decoder function type with element name decoderTypeNamed :: Core.Name -> Core.Type -> Core.Type decoderTypeNamed ename typ = @@ -2156,6 +2199,7 @@ Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.DecodingError")), Core.eitherTypeRight = resultType}))}))}) in (prependForallDecoders baseType typ) + -- | Build type scheme for a decoder function decoderTypeScheme :: Core.Type -> Core.TypeScheme decoderTypeScheme typ = @@ -2173,6 +2217,7 @@ Core.typeSchemeVariables = typeVars, Core.typeSchemeBody = (decoderType typ), Core.typeSchemeConstraints = constraints} + -- | Build type scheme for a decoder function with element name decoderTypeSchemeNamed :: Core.Name -> Core.Type -> Core.TypeScheme decoderTypeSchemeNamed ename typ = @@ -2190,14 +2235,17 @@ Core.typeSchemeVariables = typeVars, Core.typeSchemeBody = (decoderTypeNamed ename typ), Core.typeSchemeConstraints = constraints} + -- | 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)) + -- | Check if a binding is decodable (serializable type) isDecodableBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error (Maybe Core.Binding) isDecodableBinding cx graph b = Eithers.bind (Predicates.isSerializableByName cx graph (Core.bindingName b)) (\serializable -> Right (Logic.ifElse serializable (Just b) Nothing)) + -- | Prepend decoder types for forall parameters to base type prependForallDecoders :: Core.Type -> Core.Type -> Core.Type prependForallDecoders baseType typ = 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 @@ -1,28 +1,34 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Dependency extraction, binding sort, and let normalization module Hydra.Dependencies 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.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -32,8 +38,10 @@ 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 @@ -45,6 +53,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Get definitions with their dependencies definitionsWithDependencies :: t0 -> Graph.Graph -> [Core.Binding] -> Either Errors.Error [Core.Binding] definitionsWithDependencies cx graph original = @@ -52,6 +61,7 @@ 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))) in (Eithers.mapList (\name -> Lexical.requireBinding graph name) allDepNames) + -- | Flatten nested let expressions flattenLetTerms :: Core.Term -> Core.Term flattenLetTerms term = @@ -131,6 +141,7 @@ Core.letBody = newBody})) _ -> rewritten in (Rewriting.rewriteTerm flatten term) + -- | Inline all type variables in a type using the provided schema (Either version). Note: this function is only appropriate for nonrecursive type definitions inlineType :: M.Map Core.Name Core.Type -> Core.Type -> Either Errors.Error Core.Type inlineType schema typ = @@ -143,6 +154,7 @@ _ -> Right tr in (Eithers.bind (recurse typ2) (\tr -> afterRecurse tr)) in (Rewriting.rewriteTypeM f typ) + -- | Check whether a term is a lambda, possibly nested within let and/or annotation terms isLambda :: Core.Term -> Bool isLambda term = @@ -150,6 +162,7 @@ Core.TermLambda _ -> True Core.TermLet v0 -> isLambda (Core.letBody v0) _ -> False + -- | Rewrite terms like `let foo = bar in λx.baz` to `λx.let foo = bar in baz`, lifting lambda-bound variables above let-bound variables, recursively. This is helpful for targets such as Python. liftLambdaAboveLet :: Core.Term -> Core.Term liftLambdaAboveLet term0 = @@ -181,6 +194,7 @@ Core.letBody = t})) (Core.letBody v0) _ -> recurse term in (Rewriting.rewriteTerm rewrite term0) + -- | Given a let expression, remove any unused bindings. The resulting expression is still a let, even if has no remaining bindings pruneLet :: Core.Let -> Core.Let pruneLet l = @@ -194,6 +208,7 @@ in Core.Let { Core.letBindings = prunedBindings, Core.letBody = (Core.letBody l)} + -- | Replace all occurrences of simple typedefs (type aliases) with the aliased types, recursively replaceTypedefs :: M.Map Core.Name Core.TypeScheme -> Core.Type -> Core.Type replaceTypedefs types typ0 = @@ -220,6 +235,7 @@ Core.TypeWrap _ -> typ _ -> recurse typ in (Rewriting.rewriteType rewrite typ0) + -- | Simplify terms by applying beta reduction where possible simplifyTerm :: Core.Term -> Core.Term simplifyTerm term = @@ -247,6 +263,7 @@ stripped = Strip.deannotateTerm term2 in (recurse (forTerm stripped)) in (Rewriting.rewriteTerm simplify term) + -- | Note: does not distinguish between bound and free variables; use freeVariablesInTerm for that termDependencyNames :: Bool -> Bool -> Bool -> Core.Term -> S.Set Core.Name termDependencyNames binds withPrims withNoms term0 = @@ -266,6 +283,7 @@ Core.TermWrap v0 -> nominal (Core.wrappedTermTypeName v0) _ -> names in (Rewriting.foldOverTerm Coders.TraversalOrderPre addNames Sets.empty term0) + -- | Generate short names from a list of fully qualified names toShortNames :: [Core.Name] -> M.Map Core.Name Core.Name toShortNames original = @@ -286,6 +304,7 @@ \name -> \i -> (name, (Core.Name (Logic.ifElse (Equality.gt i 1) (Strings.cat2 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)))) + -- | Topological sort of connected components, in terms of dependencies between variable/term binding pairs. The SCC partitioning is what makes the result usable as an emission order in every target language: non-recursive bindings emit in dependency order, while a mutually recursive cluster is delivered together so the emitter can wrap it in whatever construct the host requires (mutual `let`s, joint class files, forward declarations). topologicalSortBindingMap :: M.Map Core.Name Core.Term -> [[(Core.Name, Core.Term)]] topologicalSortBindingMap bindingMap = @@ -304,12 +323,14 @@ toPair = \name -> (name, (Optionals.fromOptional (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. topologicalSortBindings :: [Core.Binding] -> Either [[Core.Name]] [Core.Name] topologicalSortBindings els = let adjlist = \e -> (Core.bindingName e, (Sets.toList (termDependencyNames False True True (Core.bindingTerm e)))) in (Sorting.topologicalSort (Lists.map adjlist els)) + -- | Topologically sort type definitions by their structural dependencies, grouped into SCCs. The SCC grouping handles mutually recursive types (e.g. a pair of records that reference each other's names) by delivering them together as one cluster, so the emitter can produce a coherent set of declarations rather than failing with an undefined-name error mid-emission. topologicalSortTypeDefinitions :: [Packaging.TypeDefinition] -> [[Packaging.TypeDefinition]] topologicalSortTypeDefinitions defs = @@ -321,10 +342,12 @@ 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) + -- | 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 typeDependencyNames withSchema typ = Logic.ifElse withSchema (Sets.union (Variables.freeVariablesInType typ) (typeNamesInType typ)) (Variables.freeVariablesInType typ) + -- | Collect every type name that appears anywhere inside a type expression typeNamesInType :: Ord t0 => (Core.Type -> S.Set t0) typeNamesInType typ0 = 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 @@ -1,29 +1,37 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Source-to-source automatic differentiation for Float64 terms. module Hydra.Differentiation 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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs +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.Pairs as Pairs 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.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 @@ -33,6 +41,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Differentiate a binary primitive application given both arguments and their derivatives differentiateBinary :: Core.Name -> Core.Term -> Core.Term -> Core.Term -> Core.Term -> Core.Term differentiateBinary bfname a b da db = @@ -167,6 +176,7 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.log")), Core.applicationArgument = a}))}))})), Core.applicationArgument = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 (-1.0))))}))})) (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.0)))))))) + -- | Differentiate a function term (Float64 -> Float64) with respect to its parameter differentiateFunction :: Core.Term -> Core.Term differentiateFunction term = @@ -180,6 +190,7 @@ Core.lambdaDomain = (Core.lambdaDomain v0), Core.lambdaBody = (differentiateTerm paramName body)})) _ -> term + -- | Differentiate a term with respect to a named variable differentiateTerm :: Core.Name -> Core.Term -> Core.Term differentiateTerm dx term = @@ -251,6 +262,7 @@ Core.TermOptional _ -> Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.0)) Core.TermInject _ -> Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.0)) Core.TermWrap _ -> Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.0)) + -- | Compute the gradient of a term as a record of partial derivatives gradient :: Core.Name -> [Core.Name] -> Core.Term -> Core.Term gradient typeName vars term = @@ -259,6 +271,7 @@ Core.recordFields = (Lists.map (\v -> Core.Field { Core.fieldName = v, Core.fieldTerm = (differentiateTerm v term)}) vars)}) + -- | Look up the derivative of a unary Float64 primitive primitiveDerivative :: Core.Name -> Maybe Core.Term primitiveDerivative name = diff --git a/src/main/haskell/Hydra/Docs.hs b/src/main/haskell/Hydra/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Docs.hs @@ -0,0 +1,24 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A model for Hydra documentation strings, including inline annotations and entity references + +module Hydra.Docs where + +import qualified Hydra.Core as Core +import qualified Hydra.Packaging as Packaging +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | A segment of a documentation string, either a raw text fragment or an inline entity reference. Documentation strings are parsed into a sequence of DocSegments for host-specific rendering. +data DocSegment = + -- | An inline reference to a Hydra entity + DocSegmentRef Packaging.EntityReference | + -- | A raw prose fragment, passed through verbatim + DocSegmentText String + deriving (Eq, Ord, Read, Show) + +_DocSegment = Core.Name "hydra.docs.DocSegment" + +_DocSegment_ref = Core.Name "ref" + +_DocSegment_text = Core.Name "text" diff --git a/src/main/haskell/Hydra/Dsl/Annotations.hs b/src/main/haskell/Hydra/Dsl/Annotations.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Annotations.hs +++ /dev/null @@ -1,85 +0,0 @@ --- | A DSL which is used as a basis for some of the other DSLs - -module Hydra.Dsl.Annotations where - -import Hydra.Core -import Hydra.Util -import Hydra.Constants -import Hydra.Annotations -import Hydra.Dsl.AsType -import Hydra.Formatting -import Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types - -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -annotateTerm :: Name -> Y.Maybe Term -> Term -> Term -annotateTerm = setTermAnnotation - -annotateType :: Name -> Y.Maybe Term -> Type -> Type -annotateType = setTypeAnnotation - -bounded :: Maybe Int -> Maybe Int -> Type -> Type -bounded min max = annotMin . annotMax - where - annotMax t = Y.maybe t (`setMaxLength` t) max - annotMin t = Y.maybe t (`setMinLength` t) max - -boundedList :: AsType a => Maybe Int -> Maybe Int -> a -> Type -boundedList min max et = bounded min max $ Types.list (asType et) - -boundedMap :: (AsType a, AsType b) => Maybe Int -> Maybe Int -> a -> b -> Type -boundedMap min max kt vt = bounded min max $ Types.map (asType kt) (asType vt) - -boundedSet :: AsType a => Maybe Int -> Maybe Int -> a -> Type -boundedSet min max et = bounded min max $ Types.set (asType et) - -boundedString :: Maybe Int -> Maybe Int -> Type -boundedString min max = bounded min max Types.string - -dataDoc :: String -> Term -> Term -dataDoc s = setTermDescription (Just s) - -deprecated :: AsType a => a -> Type -deprecated = setTypeAnnotation keyDeprecated (Just $ Terms.boolean True) . asType - -doc :: AsType a => String -> a -> Type -doc s = setTypeDescription (Just s) . asType - -doc70 :: AsType a => String -> a -> Type -doc70 = doc . wrapLine 70 - -doc80 :: AsType a => String -> a -> Type -doc80 = doc . wrapLine 80 - -exclude :: AsType a => a -> Type -exclude = setTypeAnnotation keyExclude (Just $ Terms.boolean True) . asType - -minLengthList :: AsType a => Int -> a -> Type -minLengthList len = boundedList (Just len) Nothing - -nonemptyList :: AsType a => a -> Type -nonemptyList = minLengthList 1 - -nonemptyMap :: (AsType a, AsType b) => a -> b -> Type -nonemptyMap = boundedMap (Just 1) Nothing - -note :: AsType a => String -> a -> Type -note s = doc $ "Note: " ++ s - -preserveFieldName :: AsType a => a -> Type -preserveFieldName = setTypeAnnotation keyPreserveFieldName (Just $ Terms.boolean True) . asType - -see :: AsType a => String -> a -> Type -see s = doc $ "See " ++ s - -setMaxLength :: Int -> Type -> Type -setMaxLength m = setTypeAnnotation keyMaxLength (Just $ Terms.int32 m) - -setMinLength :: Int -> Type -> Type -setMinLength m = setTypeAnnotation keyMinLength (Just $ Terms.int32 m) - -twoOrMoreList :: AsType a => a -> Type -twoOrMoreList = boundedList (Just 2) Nothing diff --git a/src/main/haskell/Hydra/Dsl/AsTerm.hs b/src/main/haskell/Hydra/Dsl/AsTerm.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/AsTerm.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} - --- | Type class for implicit coercion to TypedTerm --- This allows TypedTerm, TypedBinding, and String to be used where a TypedTerm is expected, --- while preserving phantom type information. - -module Hydra.Dsl.AsTerm where - -import Hydra.Core -import Hydra.Packaging -import Hydra.Typed - - --- | Type class for implicit coercion to TypedTerm, preserving phantom types --- TypedTerm passes through unchanged, TypedBinding becomes a variable reference --- The functional dependency ensures that the input type determines the phantom type -class AsTerm f a | f -> a where - asTerm :: f -> TypedTerm a - -instance AsTerm (TypedTerm a) a where - asTerm = id - -instance AsTerm (TypedBinding a) a where - asTerm (TypedBinding name _) = TypedTerm (TermVariable name) - -instance AsTerm (TypedTermDefinition a) a where - asTerm (TypedTermDefinition name _) = TypedTerm (TermVariable name) - -instance AsTerm String String where - asTerm s = TypedTerm $ TermLiteral $ LiteralString s - -instance AsTerm Int Int where - asTerm i = TypedTerm $ TermLiteral $ LiteralInteger $ IntegerValueInt32 i - - --- | Type class for types from which a kernel-level 'Name' can be statically extracted. --- Used by Phantoms primitives like 'inject', 'match', 'project', 'record', 'unwrap', 'wrap' --- to accept either a bare 'Name' or any name-typed binding/definition where the 'Name' --- is known at construction time. Distinct from 'AsTerm' (which can lift arbitrary --- @TypedTerm Name@ values, but those don't yield a static 'Name'). -class AsName n where - asName :: n -> Name - -instance AsName Name where - asName = id - -instance AsName (TypedBinding Name) where - asName (TypedBinding name _) = name - -instance AsName (TypedTermDefinition Name) where - asName (TypedTermDefinition name _) = name diff --git a/src/main/haskell/Hydra/Dsl/AsType.hs b/src/main/haskell/Hydra/Dsl/AsType.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/AsType.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - --- | Type class for implicit coercion to Type --- This allows Type, TypeDefinition, and String to be used where a Type is expected - -module Hydra.Dsl.AsType where - -import Hydra.Core -import Hydra.Packaging - - --- | Type class for implicit coercion to Type --- This allows Type, TypeDefinition, and String to be used where a Type is expected -class AsType a where - asType :: a -> Type - -instance AsType Type where - asType = id - --- | A TypeDefinition is referenced as a type variable bearing its name. -instance AsType TypeDefinition where - asType = TypeVariable . typeDefinitionName - -instance AsType String where - asType s = TypeVariable (Name s) 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.ast module Hydra.Dsl.Ast where + import qualified Hydra.Ast as Ast import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore 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 both variant of hydra.ast.Associativity associativityBoth :: Typed.TypedTerm Ast.Associativity associativityBoth = @@ -16,6 +19,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "both"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the left variant of hydra.ast.Associativity associativityLeft :: Typed.TypedTerm Ast.Associativity associativityLeft = @@ -24,6 +28,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "left"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the none variant of hydra.ast.Associativity associativityNone :: Typed.TypedTerm Ast.Associativity associativityNone = @@ -32,6 +37,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "none"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the right variant of hydra.ast.Associativity associativityRight :: Typed.TypedTerm Ast.Associativity associativityRight = @@ -40,6 +46,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.ast.BlockStyle blockStyle :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Ast.BlockStyle blockStyle indent newlineBeforeContent newlineAfterContent = @@ -55,6 +62,7 @@ Core.Field { Core.fieldName = (Core.Name "newlineAfterContent"), Core.fieldTerm = (Typed.unTypedTerm newlineAfterContent)}]})) + -- | DSL accessor for the indent field of hydra.ast.BlockStyle blockStyleIndent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm (Maybe String) blockStyleIndent x = @@ -63,6 +71,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BlockStyle"), Core.projectionFieldName = (Core.Name "indent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the newlineAfterContent field of hydra.ast.BlockStyle blockStyleNewlineAfterContent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Bool blockStyleNewlineAfterContent x = @@ -71,6 +80,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BlockStyle"), Core.projectionFieldName = (Core.Name "newlineAfterContent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the newlineBeforeContent field of hydra.ast.BlockStyle blockStyleNewlineBeforeContent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Bool blockStyleNewlineBeforeContent x = @@ -79,6 +89,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BlockStyle"), Core.projectionFieldName = (Core.Name "newlineBeforeContent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the indent field of hydra.ast.BlockStyle blockStyleWithIndent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Ast.BlockStyle blockStyleWithIndent original newVal = @@ -102,6 +113,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BlockStyle"), Core.projectionFieldName = (Core.Name "newlineAfterContent")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the newlineAfterContent field of hydra.ast.BlockStyle blockStyleWithNewlineAfterContent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Bool -> Typed.TypedTerm Ast.BlockStyle blockStyleWithNewlineAfterContent original newVal = @@ -125,6 +137,7 @@ Core.Field { Core.fieldName = (Core.Name "newlineAfterContent"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the newlineBeforeContent field of hydra.ast.BlockStyle blockStyleWithNewlineBeforeContent :: Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Bool -> Typed.TypedTerm Ast.BlockStyle blockStyleWithNewlineBeforeContent original newVal = @@ -148,6 +161,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BlockStyle"), Core.projectionFieldName = (Core.Name "newlineAfterContent")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.ast.BracketExpr bracketExpr :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Ast.BracketExpr bracketExpr brackets enclosed style = @@ -163,6 +177,7 @@ Core.Field { Core.fieldName = (Core.Name "style"), Core.fieldTerm = (Typed.unTypedTerm style)}]})) + -- | DSL accessor for the brackets field of hydra.ast.BracketExpr bracketExprBrackets :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Brackets bracketExprBrackets x = @@ -171,6 +186,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BracketExpr"), Core.projectionFieldName = (Core.Name "brackets")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the enclosed field of hydra.ast.BracketExpr bracketExprEnclosed :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Expr bracketExprEnclosed x = @@ -179,6 +195,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BracketExpr"), Core.projectionFieldName = (Core.Name "enclosed")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the style field of hydra.ast.BracketExpr bracketExprStyle :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.BlockStyle bracketExprStyle x = @@ -187,6 +204,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BracketExpr"), Core.projectionFieldName = (Core.Name "style")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the brackets field of hydra.ast.BracketExpr bracketExprWithBrackets :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.BracketExpr bracketExprWithBrackets original newVal = @@ -210,6 +228,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BracketExpr"), Core.projectionFieldName = (Core.Name "style")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the enclosed field of hydra.ast.BracketExpr bracketExprWithEnclosed :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.BracketExpr bracketExprWithEnclosed original newVal = @@ -233,6 +252,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.BracketExpr"), Core.projectionFieldName = (Core.Name "style")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the style field of hydra.ast.BracketExpr bracketExprWithStyle :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.BlockStyle -> Typed.TypedTerm Ast.BracketExpr bracketExprWithStyle original newVal = @@ -256,6 +276,7 @@ Core.Field { Core.fieldName = (Core.Name "style"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.ast.Brackets brackets :: Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Brackets brackets open close = @@ -268,6 +289,7 @@ Core.Field { Core.fieldName = (Core.Name "close"), Core.fieldTerm = (Typed.unTypedTerm close)}]})) + -- | DSL accessor for the close field of hydra.ast.Brackets bracketsClose :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Symbol bracketsClose x = @@ -276,6 +298,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Brackets"), Core.projectionFieldName = (Core.Name "close")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the open field of hydra.ast.Brackets bracketsOpen :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Symbol bracketsOpen x = @@ -284,6 +307,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Brackets"), Core.projectionFieldName = (Core.Name "open")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the close field of hydra.ast.Brackets bracketsWithClose :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Brackets bracketsWithClose original newVal = @@ -300,6 +324,7 @@ Core.Field { Core.fieldName = (Core.Name "close"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the open field of hydra.ast.Brackets bracketsWithOpen :: Typed.TypedTerm Ast.Brackets -> Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Brackets bracketsWithOpen original newVal = @@ -316,6 +341,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Brackets"), Core.projectionFieldName = (Core.Name "close")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the brackets variant of hydra.ast.Expr exprBrackets :: Typed.TypedTerm Ast.BracketExpr -> Typed.TypedTerm Ast.Expr exprBrackets x = @@ -324,6 +350,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "brackets"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the const variant of hydra.ast.Expr exprConst :: Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Expr exprConst x = @@ -332,6 +359,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "const"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the indent variant of hydra.ast.Expr exprIndent :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.Expr exprIndent x = @@ -340,6 +368,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "indent"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the op variant of hydra.ast.Expr exprOp :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr exprOp x = @@ -348,6 +377,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "op"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the seq variant of hydra.ast.Expr exprSeq :: Typed.TypedTerm Ast.SeqExpr -> Typed.TypedTerm Ast.Expr exprSeq x = @@ -356,6 +386,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "seq"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the allLines variant of hydra.ast.IndentStyle indentStyleAllLines :: Typed.TypedTerm String -> Typed.TypedTerm Ast.IndentStyle indentStyleAllLines x = @@ -364,6 +395,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "allLines"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the subsequentLines variant of hydra.ast.IndentStyle indentStyleSubsequentLines :: Typed.TypedTerm String -> Typed.TypedTerm Ast.IndentStyle indentStyleSubsequentLines x = @@ -372,6 +404,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "subsequentLines"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.ast.IndentedExpression indentedExpression :: Typed.TypedTerm Ast.IndentStyle -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.IndentedExpression indentedExpression style expr = @@ -384,6 +417,7 @@ Core.Field { Core.fieldName = (Core.Name "expr"), Core.fieldTerm = (Typed.unTypedTerm expr)}]})) + -- | DSL accessor for the expr field of hydra.ast.IndentedExpression indentedExpressionExpr :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.Expr indentedExpressionExpr x = @@ -392,6 +426,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.IndentedExpression"), Core.projectionFieldName = (Core.Name "expr")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the style field of hydra.ast.IndentedExpression indentedExpressionStyle :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.IndentStyle indentedExpressionStyle x = @@ -400,6 +435,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.IndentedExpression"), Core.projectionFieldName = (Core.Name "style")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the expr field of hydra.ast.IndentedExpression indentedExpressionWithExpr :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.IndentedExpression indentedExpressionWithExpr original newVal = @@ -416,6 +452,7 @@ Core.Field { Core.fieldName = (Core.Name "expr"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the style field of hydra.ast.IndentedExpression indentedExpressionWithStyle :: Typed.TypedTerm Ast.IndentedExpression -> Typed.TypedTerm Ast.IndentStyle -> Typed.TypedTerm Ast.IndentedExpression indentedExpressionWithStyle original newVal = @@ -432,6 +469,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.IndentedExpression"), Core.projectionFieldName = (Core.Name "expr")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.ast.Op op :: Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Precedence -> Typed.TypedTerm Ast.Associativity -> Typed.TypedTerm Ast.Op op symbol padding precedence associativity = @@ -450,6 +488,7 @@ Core.Field { Core.fieldName = (Core.Name "associativity"), Core.fieldTerm = (Typed.unTypedTerm associativity)}]})) + -- | DSL accessor for the associativity field of hydra.ast.Op opAssociativity :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Associativity opAssociativity x = @@ -458,6 +497,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "associativity")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.ast.OpExpr opExpr :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.OpExpr opExpr op lhs rhs = @@ -473,6 +513,7 @@ Core.Field { Core.fieldName = (Core.Name "rhs"), Core.fieldTerm = (Typed.unTypedTerm rhs)}]})) + -- | DSL accessor for the lhs field of hydra.ast.OpExpr opExprLhs :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr opExprLhs x = @@ -481,6 +522,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.OpExpr"), Core.projectionFieldName = (Core.Name "lhs")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the op field of hydra.ast.OpExpr opExprOp :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Op opExprOp x = @@ -489,6 +531,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.OpExpr"), Core.projectionFieldName = (Core.Name "op")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the rhs field of hydra.ast.OpExpr opExprRhs :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr opExprRhs x = @@ -497,6 +540,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.OpExpr"), Core.projectionFieldName = (Core.Name "rhs")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the lhs field of hydra.ast.OpExpr opExprWithLhs :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.OpExpr opExprWithLhs original newVal = @@ -520,6 +564,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.OpExpr"), Core.projectionFieldName = (Core.Name "rhs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the op field of hydra.ast.OpExpr opExprWithOp :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.OpExpr opExprWithOp original newVal = @@ -543,6 +588,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.OpExpr"), Core.projectionFieldName = (Core.Name "rhs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the rhs field of hydra.ast.OpExpr opExprWithRhs :: Typed.TypedTerm Ast.OpExpr -> Typed.TypedTerm Ast.Expr -> Typed.TypedTerm Ast.OpExpr opExprWithRhs original newVal = @@ -566,6 +612,7 @@ Core.Field { Core.fieldName = (Core.Name "rhs"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL accessor for the padding field of hydra.ast.Op opPadding :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Padding opPadding x = @@ -574,6 +621,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "padding")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the precedence field of hydra.ast.Op opPrecedence :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Precedence opPrecedence x = @@ -582,6 +630,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "precedence")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the symbol field of hydra.ast.Op opSymbol :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Symbol opSymbol x = @@ -590,6 +639,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "symbol")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the associativity field of hydra.ast.Op opWithAssociativity :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Associativity -> Typed.TypedTerm Ast.Op opWithAssociativity original newVal = @@ -620,6 +670,7 @@ Core.Field { Core.fieldName = (Core.Name "associativity"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the padding field of hydra.ast.Op opWithPadding :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Op opWithPadding original newVal = @@ -650,6 +701,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "associativity")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the precedence field of hydra.ast.Op opWithPrecedence :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Precedence -> Typed.TypedTerm Ast.Op opWithPrecedence original newVal = @@ -680,6 +732,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "associativity")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the symbol field of hydra.ast.Op opWithSymbol :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm Ast.Op opWithSymbol original newVal = @@ -710,6 +763,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Op"), Core.projectionFieldName = (Core.Name "associativity")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.ast.Padding padding :: Typed.TypedTerm Ast.Ws -> Typed.TypedTerm Ast.Ws -> Typed.TypedTerm Ast.Padding padding left right = @@ -722,6 +776,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm right)}]})) + -- | DSL accessor for the left field of hydra.ast.Padding paddingLeft :: Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Ws paddingLeft x = @@ -730,6 +785,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Padding"), Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the right field of hydra.ast.Padding paddingRight :: Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Ws paddingRight x = @@ -738,6 +794,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Padding"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the left field of hydra.ast.Padding paddingWithLeft :: Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Ws -> Typed.TypedTerm Ast.Padding paddingWithLeft original newVal = @@ -754,6 +811,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.Padding"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the right field of hydra.ast.Padding paddingWithRight :: Typed.TypedTerm Ast.Padding -> Typed.TypedTerm Ast.Ws -> Typed.TypedTerm Ast.Padding paddingWithRight original newVal = @@ -770,12 +828,14 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.ast.Precedence wrapper precedence :: Typed.TypedTerm Int -> Typed.TypedTerm Ast.Precedence precedence x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.ast.Precedence"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.ast.SeqExpr seqExpr :: Typed.TypedTerm Ast.Op -> Typed.TypedTerm [Ast.Expr] -> Typed.TypedTerm Ast.SeqExpr seqExpr op elements = @@ -788,6 +848,7 @@ Core.Field { Core.fieldName = (Core.Name "elements"), Core.fieldTerm = (Typed.unTypedTerm elements)}]})) + -- | DSL accessor for the elements field of hydra.ast.SeqExpr seqExprElements :: Typed.TypedTerm Ast.SeqExpr -> Typed.TypedTerm [Ast.Expr] seqExprElements x = @@ -796,6 +857,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.SeqExpr"), Core.projectionFieldName = (Core.Name "elements")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the op field of hydra.ast.SeqExpr seqExprOp :: Typed.TypedTerm Ast.SeqExpr -> Typed.TypedTerm Ast.Op seqExprOp x = @@ -804,6 +866,7 @@ Core.projectionTypeName = (Core.Name "hydra.ast.SeqExpr"), Core.projectionFieldName = (Core.Name "op")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -820,6 +883,7 @@ Core.Field { Core.fieldName = (Core.Name "elements"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the op field of hydra.ast.SeqExpr seqExprWithOp :: Typed.TypedTerm Ast.SeqExpr -> Typed.TypedTerm Ast.Op -> Typed.TypedTerm Ast.SeqExpr seqExprWithOp original newVal = @@ -836,24 +900,28 @@ Core.projectionTypeName = (Core.Name "hydra.ast.SeqExpr"), Core.projectionFieldName = (Core.Name "elements")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.ast.Symbol wrapper symbol :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Symbol symbol x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.ast.Symbol"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.ast.Precedence unPrecedence :: Typed.TypedTerm Ast.Precedence -> Typed.TypedTerm Int unPrecedence x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.ast.Precedence")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.ast.Symbol unSymbol :: Typed.TypedTerm Ast.Symbol -> Typed.TypedTerm String unSymbol x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.ast.Symbol")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL injection for the break variant of hydra.ast.Ws wsBreak :: Typed.TypedTerm Ast.Ws wsBreak = @@ -862,6 +930,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "break"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the breakAndIndent variant of hydra.ast.Ws wsBreakAndIndent :: Typed.TypedTerm String -> Typed.TypedTerm Ast.Ws wsBreakAndIndent x = @@ -870,6 +939,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "breakAndIndent"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the doubleBreak variant of hydra.ast.Ws wsDoubleBreak :: Typed.TypedTerm Ast.Ws wsDoubleBreak = @@ -878,6 +948,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "doubleBreak"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the none variant of hydra.ast.Ws wsNone :: Typed.TypedTerm Ast.Ws wsNone = @@ -886,6 +957,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "none"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the space variant of hydra.ast.Ws wsSpace :: Typed.TypedTerm Ast.Ws wsSpace = diff --git a/src/main/haskell/Hydra/Dsl/Bootstrap.hs b/src/main/haskell/Hydra/Dsl/Bootstrap.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Bootstrap.hs +++ /dev/null @@ -1,76 +0,0 @@ --- | A bootstrapping DSL, used for Hydra's inner core models - -module Hydra.Dsl.Bootstrap ( - module Hydra.Dsl.AsType, - bootstrapGraph, - datatype, - descriptionMetadata, - qualify, - qualifiedDep, - typeref, - defineType, - unqualifiedDep, -) where - -import Hydra.Util -import Hydra.Constants -import Hydra.Core -import Hydra.Dsl.AsType -import Hydra.Graph -import Hydra.Lexical -import Hydra.Annotations -import Hydra.Packaging -import Hydra.Dsl.Libraries - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S - - --- | An empty graph (no elements, no schema, but with primitive functions) which is used for bootstrapping Hydra Core -bootstrapGraph :: Graph -bootstrapGraph = Graph { - graphBoundTerms = M.empty, - graphBoundTypes = M.empty, - graphClassConstraints = M.empty, - graphLambdaVariables = S.empty, - graphMetadata = M.empty, - graphPrimitives = M.fromList $ fmap (\p -> (primitiveDefinitionName (primitiveDefinition p), p)) (L.concat (libraryPrimitives <$> standardLibraries)), - graphSchemaTypes = M.empty, - graphTypeVariables = S.empty} - --- | Define a type in a namespace, producing a TypeDefinition directly. -datatype :: ModuleName -> String -> Type -> TypeDefinition -datatype gname lname typ = TypeDefinition { - typeDefinitionName = qualify gname (Name lname), - typeDefinitionMetadata = Nothing, - typeDefinitionBody = TypeScheme { - typeSchemeVariables = [], - typeSchemeBody = typ, - typeSchemeConstraints = Nothing}} - --- | Define a type in a namespace -defineType :: ModuleName -> String -> Type -> TypeDefinition -defineType = datatype - --- | A module dependency qualified by the providing package, for disambiguation. --- Not yet used, but retained for forthcoming package-qualified dependency resolution. -qualifiedDep :: PackageName -> ModuleName -> ModuleDependency -qualifiedDep pkg ns = ModuleDependency ns (Just pkg) - -qualify :: ModuleName -> Name -> Name -qualify (ModuleName gname) (Name lname) = Name $ gname ++ "." ++ lname - -typeref :: ModuleName -> String -> Type -typeref ns = TypeVariable . qualify ns . Name - --- | An unqualified module dependency (package omitted; resolver searches all packages in scope) -unqualifiedDep :: ModuleName -> ModuleDependency -unqualifiedDep ns = ModuleDependency ns Nothing - --- | Wrap an optional description string as entity metadata carrying only that description. --- Used to migrate the former Module/Package `description` field into the `metadata` field --- without data loss; a Nothing description yields no metadata. -descriptionMetadata :: Maybe String -> Maybe EntityMetadata -descriptionMetadata Nothing = Nothing -descriptionMetadata desc = Just (EntityMetadata desc [] [] Nothing) 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 @@ -1,27 +1,30 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.coders module Hydra.Dsl.Coders where + import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core 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.Typing as DslTyping import qualified Hydra.Dsl.Util as DslUtil import qualified Hydra.Dsl.Variants as DslVariants import qualified Hydra.Errors as Errors +import qualified Hydra.File as File import qualified Hydra.Graph as Graph 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 import qualified Data.Set as S + -- | DSL constructor for hydra.coders.Adapter -adapter :: Typed.TypedTerm Bool -> Typed.TypedTerm t1 -> Typed.TypedTerm t2 -> Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) +adapter :: Typed.TypedTerm Bool -> Typed.TypedTerm t1 -> Typed.TypedTerm t2 -> Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) adapter isLossy source target coder = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Adapter"), @@ -38,16 +41,18 @@ Core.Field { Core.fieldName = (Core.Name "coder"), Core.fieldTerm = (Typed.unTypedTerm coder)}]})) + -- | DSL accessor for the coder field of hydra.coders.Adapter -adapterCoder :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm (Coders.Coder v1 v2) +adapterCoder :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm (Coders.Coder v1 v2 e) adapterCoder x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "coder")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.coders.AdapterContext -adapterContext :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Coders.Language -> Typed.TypedTerm (M.Map Core.Name (Coders.Adapter Core.Type Core.Type Core.Term Core.Term)) -> Typed.TypedTerm Coders.AdapterContext +adapterContext :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Coders.Language -> Typed.TypedTerm (M.Map Core.Name (Coders.Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error)) -> Typed.TypedTerm Coders.AdapterContext adapterContext graph language adapters = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.AdapterContext"), @@ -61,14 +66,16 @@ Core.Field { Core.fieldName = (Core.Name "adapters"), Core.fieldTerm = (Typed.unTypedTerm adapters)}]})) + -- | 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)) +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 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.AdapterContext"), Core.projectionFieldName = (Core.Name "adapters")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the graph field of hydra.coders.AdapterContext adapterContextGraph :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm Graph.Graph adapterContextGraph x = @@ -77,6 +84,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.AdapterContext"), Core.projectionFieldName = (Core.Name "graph")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the language field of hydra.coders.AdapterContext adapterContextLanguage :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm Coders.Language adapterContextLanguage x = @@ -85,8 +93,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.AdapterContext"), Core.projectionFieldName = (Core.Name "language")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the adapters field of hydra.coders.AdapterContext -adapterContextWithAdapters :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm (M.Map Core.Name (Coders.Adapter Core.Type Core.Type Core.Term Core.Term)) -> Typed.TypedTerm Coders.AdapterContext +adapterContextWithAdapters :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm (M.Map Core.Name (Coders.Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error)) -> Typed.TypedTerm Coders.AdapterContext adapterContextWithAdapters original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.AdapterContext"), @@ -108,6 +117,7 @@ Core.Field { Core.fieldName = (Core.Name "adapters"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the graph field of hydra.coders.AdapterContext adapterContextWithGraph :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Coders.AdapterContext adapterContextWithGraph original newVal = @@ -131,6 +141,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.AdapterContext"), Core.projectionFieldName = (Core.Name "adapters")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the language field of hydra.coders.AdapterContext adapterContextWithLanguage :: Typed.TypedTerm Coders.AdapterContext -> Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.AdapterContext adapterContextWithLanguage original newVal = @@ -154,32 +165,36 @@ Core.projectionTypeName = (Core.Name "hydra.coders.AdapterContext"), Core.projectionFieldName = (Core.Name "adapters")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the isLossy field of hydra.coders.Adapter -adapterIsLossy :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm Bool +adapterIsLossy :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm Bool adapterIsLossy x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "isLossy")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the source field of hydra.coders.Adapter -adapterSource :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm t1 +adapterSource :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm t1 adapterSource x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "source")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the target field of hydra.coders.Adapter -adapterTarget :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm t2 +adapterTarget :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm t2 adapterTarget x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the coder field of hydra.coders.Adapter -adapterWithCoder :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) +adapterWithCoder :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) adapterWithCoder original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Adapter"), @@ -208,8 +223,9 @@ Core.Field { Core.fieldName = (Core.Name "coder"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the isLossy field of hydra.coders.Adapter -adapterWithIsLossy :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm Bool -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) +adapterWithIsLossy :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm Bool -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) adapterWithIsLossy original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Adapter"), @@ -238,8 +254,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "coder")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the source field of hydra.coders.Adapter -adapterWithSource :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm t1 -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) +adapterWithSource :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm t1 -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) adapterWithSource original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Adapter"), @@ -268,8 +285,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "coder")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the target field of hydra.coders.Adapter -adapterWithTarget :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm t2 -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2) +adapterWithTarget :: Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm t2 -> Typed.TypedTerm (Coders.Adapter t1 t2 v1 v2 e) adapterWithTarget original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Adapter"), @@ -298,8 +316,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Adapter"), Core.projectionFieldName = (Core.Name "coder")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.coders.Bicoder -bicoder :: Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) +bicoder :: Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1 e) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) bicoder encode decode = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Bicoder"), @@ -310,24 +329,27 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) + -- | DSL accessor for the decode field of hydra.coders.Bicoder -bicoderDecode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1) +bicoderDecode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1 e) bicoderDecode x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Bicoder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the encode field of hydra.coders.Bicoder -bicoderEncode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) -> Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2) +bicoderEncode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) -> Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2 e) bicoderEncode x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Bicoder"), Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the decode field of hydra.coders.Bicoder -bicoderWithDecode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) +bicoderWithDecode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) -> Typed.TypedTerm (t2 -> Coders.Adapter t2 t1 v2 v1 e) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) bicoderWithDecode original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Bicoder"), @@ -342,8 +364,9 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the encode field of hydra.coders.Bicoder -bicoderWithEncode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) -> Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2) +bicoderWithEncode :: Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) -> Typed.TypedTerm (t1 -> Coders.Adapter t1 t2 v1 v2 e) -> Typed.TypedTerm (Coders.Bicoder t1 t2 v1 v2 e) bicoderWithEncode original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Bicoder"), @@ -358,6 +381,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Bicoder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.coders.CaseConventions caseConventions :: Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventions constant directory enumValue field file module_ term termVariable type_ typeVariable = @@ -394,6 +418,7 @@ Core.Field { Core.fieldName = (Core.Name "typeVariable"), Core.fieldTerm = (Typed.unTypedTerm typeVariable)}]})) + -- | DSL accessor for the constant field of hydra.coders.CaseConventions caseConventionsConstant :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsConstant x = @@ -402,6 +427,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "constant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the directory field of hydra.coders.CaseConventions caseConventionsDirectory :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsDirectory x = @@ -410,6 +436,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "directory")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the enumValue field of hydra.coders.CaseConventions caseConventionsEnumValue :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsEnumValue x = @@ -418,6 +445,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "enumValue")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the field field of hydra.coders.CaseConventions caseConventionsField :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsField x = @@ -426,6 +454,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "field")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the file field of hydra.coders.CaseConventions caseConventionsFile :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsFile x = @@ -434,6 +463,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "file")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the module field of hydra.coders.CaseConventions caseConventionsModule :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsModule x = @@ -442,6 +472,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "module")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the term field of hydra.coders.CaseConventions caseConventionsTerm :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsTerm x = @@ -450,6 +481,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "term")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the termVariable field of hydra.coders.CaseConventions caseConventionsTermVariable :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsTermVariable x = @@ -458,6 +490,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "termVariable")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.coders.CaseConventions caseConventionsType :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsType x = @@ -466,6 +499,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeVariable field of hydra.coders.CaseConventions caseConventionsTypeVariable :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention caseConventionsTypeVariable x = @@ -474,6 +508,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the constant field of hydra.coders.CaseConventions caseConventionsWithConstant :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithConstant original newVal = @@ -546,6 +581,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the directory field of hydra.coders.CaseConventions caseConventionsWithDirectory :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithDirectory original newVal = @@ -618,6 +654,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the enumValue field of hydra.coders.CaseConventions caseConventionsWithEnumValue :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithEnumValue original newVal = @@ -690,6 +727,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the field field of hydra.coders.CaseConventions caseConventionsWithField :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithField original newVal = @@ -762,6 +800,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the file field of hydra.coders.CaseConventions caseConventionsWithFile :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithFile original newVal = @@ -834,6 +873,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the module field of hydra.coders.CaseConventions caseConventionsWithModule :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithModule original newVal = @@ -906,6 +946,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the term field of hydra.coders.CaseConventions caseConventionsWithTerm :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithTerm original newVal = @@ -978,6 +1019,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the termVariable field of hydra.coders.CaseConventions caseConventionsWithTermVariable :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithTermVariable original newVal = @@ -1050,6 +1092,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.coders.CaseConventions caseConventionsWithType :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithType original newVal = @@ -1122,6 +1165,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.CaseConventions"), Core.projectionFieldName = (Core.Name "typeVariable")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeVariable field of hydra.coders.CaseConventions caseConventionsWithTypeVariable :: Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm Coders.CaseConventions caseConventionsWithTypeVariable original newVal = @@ -1194,8 +1238,9 @@ Core.Field { Core.fieldName = (Core.Name "typeVariable"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.coders.Coder -coder :: Typed.TypedTerm (Typing.InferenceContext -> v1 -> Either Errors.Error v2) -> Typed.TypedTerm (Typing.InferenceContext -> v2 -> Either Errors.Error v1) -> Typed.TypedTerm (Coders.Coder v1 v2) +coder :: Typed.TypedTerm (v1 -> Either e v2) -> Typed.TypedTerm (v2 -> Either e v1) -> Typed.TypedTerm (Coders.Coder v1 v2 e) coder encode decode = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Coder"), @@ -1206,14 +1251,16 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) + -- | DSL accessor for the decode field of hydra.coders.Coder -coderDecode :: Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Typing.InferenceContext -> v2 -> Either Errors.Error v1) +coderDecode :: Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (v2 -> Either e v1) coderDecode x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Coder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL injection for the decode variant of hydra.coders.CoderDirection coderDirectionDecode :: Typed.TypedTerm Coders.CoderDirection coderDirectionDecode = @@ -1222,6 +1269,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the encode variant of hydra.coders.CoderDirection coderDirectionEncode :: Typed.TypedTerm Coders.CoderDirection coderDirectionEncode = @@ -1230,16 +1278,18 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "encode"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL accessor for the encode field of hydra.coders.Coder -coderEncode :: Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Typing.InferenceContext -> v1 -> Either Errors.Error v2) +coderEncode :: Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (v1 -> Either e v2) coderEncode x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Coder"), Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the decode field of hydra.coders.Coder -coderWithDecode :: Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Typing.InferenceContext -> v2 -> Either Errors.Error v1) -> Typed.TypedTerm (Coders.Coder v1 v2) +coderWithDecode :: Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (v2 -> Either e v1) -> Typed.TypedTerm (Coders.Coder v1 v2 e) coderWithDecode original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Coder"), @@ -1254,8 +1304,9 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the encode field of hydra.coders.Coder -coderWithEncode :: Typed.TypedTerm (Coders.Coder v1 v2) -> Typed.TypedTerm (Typing.InferenceContext -> v1 -> Either Errors.Error v2) -> Typed.TypedTerm (Coders.Coder v1 v2) +coderWithEncode :: Typed.TypedTerm (Coders.Coder v1 v2 e) -> Typed.TypedTerm (v1 -> Either e v2) -> Typed.TypedTerm (Coders.Coder v1 v2 e) coderWithEncode original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Coder"), @@ -1270,8 +1321,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Coder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | 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 Util.FileExtension -> Typed.TypedTerm 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 = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Language"), @@ -1291,6 +1343,7 @@ Core.Field { Core.fieldName = (Core.Name "defaultFileExtension"), Core.fieldTerm = (Typed.unTypedTerm defaultFileExtension)}]})) + -- | DSL accessor for the caseConventions field of hydra.coders.Language languageCaseConventions :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.CaseConventions languageCaseConventions x = @@ -1299,6 +1352,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "caseConventions")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the constraints field of hydra.coders.Language languageConstraints :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.LanguageConstraints languageConstraints x = @@ -1307,6 +1361,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.coders.LanguageConstraints languageConstraints2 :: Typed.TypedTerm (S.Set Variants.LiteralVariant) -> Typed.TypedTerm (S.Set Core.FloatType) -> Typed.TypedTerm (S.Set Core.IntegerType) -> Typed.TypedTerm (S.Set Variants.TermVariant) -> Typed.TypedTerm (S.Set Variants.TypeVariant) -> Typed.TypedTerm (Core.Type -> Bool) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraints2 literalVariants floatTypes integerTypes termVariants typeVariants types = @@ -1331,6 +1386,7 @@ Core.Field { Core.fieldName = (Core.Name "types"), Core.fieldTerm = (Typed.unTypedTerm types)}]})) + -- | DSL accessor for the floatTypes field of hydra.coders.LanguageConstraints languageConstraintsFloatTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Core.FloatType) languageConstraintsFloatTypes x = @@ -1339,6 +1395,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "floatTypes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the integerTypes field of hydra.coders.LanguageConstraints languageConstraintsIntegerTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Core.IntegerType) languageConstraintsIntegerTypes x = @@ -1347,6 +1404,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "integerTypes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the literalVariants field of hydra.coders.LanguageConstraints languageConstraintsLiteralVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.LiteralVariant) languageConstraintsLiteralVariants x = @@ -1355,6 +1413,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "literalVariants")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the termVariants field of hydra.coders.LanguageConstraints languageConstraintsTermVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.TermVariant) languageConstraintsTermVariants x = @@ -1363,6 +1422,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "termVariants")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeVariants field of hydra.coders.LanguageConstraints languageConstraintsTypeVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.TypeVariant) languageConstraintsTypeVariants x = @@ -1371,6 +1431,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "typeVariants")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the types field of hydra.coders.LanguageConstraints languageConstraintsTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (Core.Type -> Bool) languageConstraintsTypes x = @@ -1379,6 +1440,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the floatTypes field of hydra.coders.LanguageConstraints languageConstraintsWithFloatTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Core.FloatType) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithFloatTypes original newVal = @@ -1423,6 +1485,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the integerTypes field of hydra.coders.LanguageConstraints languageConstraintsWithIntegerTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Core.IntegerType) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithIntegerTypes original newVal = @@ -1467,6 +1530,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the literalVariants field of hydra.coders.LanguageConstraints languageConstraintsWithLiteralVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.LiteralVariant) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithLiteralVariants original newVal = @@ -1511,6 +1575,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the termVariants field of hydra.coders.LanguageConstraints languageConstraintsWithTermVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.TermVariant) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithTermVariants original newVal = @@ -1555,6 +1620,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeVariants field of hydra.coders.LanguageConstraints languageConstraintsWithTypeVariants :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (S.Set Variants.TypeVariant) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithTypeVariants original newVal = @@ -1599,6 +1665,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.LanguageConstraints"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the types field of hydra.coders.LanguageConstraints languageConstraintsWithTypes :: Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm (Core.Type -> Bool) -> Typed.TypedTerm Coders.LanguageConstraints languageConstraintsWithTypes original newVal = @@ -1643,14 +1710,16 @@ Core.Field { Core.fieldName = (Core.Name "types"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL accessor for the defaultFileExtension field of hydra.coders.Language -languageDefaultFileExtension :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Util.FileExtension +languageDefaultFileExtension :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm File.FileExtension languageDefaultFileExtension x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL injection for the nestedCaseStatements variant of hydra.coders.LanguageFeature languageFeatureNestedCaseStatements :: Typed.TypedTerm Coders.LanguageFeature languageFeatureNestedCaseStatements = @@ -1659,6 +1728,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedCaseStatements"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the nestedPolymorphicLetBindings variant of hydra.coders.LanguageFeature languageFeatureNestedPolymorphicLetBindings :: Typed.TypedTerm Coders.LanguageFeature languageFeatureNestedPolymorphicLetBindings = @@ -1667,6 +1737,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedPolymorphicLetBindings"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the partialApplication variant of hydra.coders.LanguageFeature languageFeaturePartialApplication :: Typed.TypedTerm Coders.LanguageFeature languageFeaturePartialApplication = @@ -1675,6 +1746,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "partialApplication"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL accessor for the name field of hydra.coders.Language languageName :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.LanguageName languageName x = @@ -1683,12 +1755,14 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.coders.LanguageName wrapper languageName2 :: Typed.TypedTerm String -> Typed.TypedTerm Coders.LanguageName languageName2 x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.coders.LanguageName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL accessor for the supportedFeatures field of hydra.coders.Language languageSupportedFeatures :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm (S.Set Coders.LanguageFeature) languageSupportedFeatures x = @@ -1697,6 +1771,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "supportedFeatures")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the caseConventions field of hydra.coders.Language languageWithCaseConventions :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.CaseConventions -> Typed.TypedTerm Coders.Language languageWithCaseConventions original newVal = @@ -1734,6 +1809,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the constraints field of hydra.coders.Language languageWithConstraints :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.LanguageConstraints -> Typed.TypedTerm Coders.Language languageWithConstraints original newVal = @@ -1771,8 +1847,9 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the defaultFileExtension field of hydra.coders.Language -languageWithDefaultFileExtension :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Util.FileExtension -> Typed.TypedTerm Coders.Language +languageWithDefaultFileExtension :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm File.FileExtension -> Typed.TypedTerm Coders.Language languageWithDefaultFileExtension original newVal = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.coders.Language"), @@ -1808,6 +1885,7 @@ Core.Field { Core.fieldName = (Core.Name "defaultFileExtension"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.coders.Language languageWithName :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm Coders.LanguageName -> Typed.TypedTerm Coders.Language languageWithName original newVal = @@ -1845,6 +1923,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the supportedFeatures field of hydra.coders.Language languageWithSupportedFeatures :: Typed.TypedTerm Coders.Language -> Typed.TypedTerm (S.Set Coders.LanguageFeature) -> Typed.TypedTerm Coders.Language languageWithSupportedFeatures original newVal = @@ -1882,6 +1961,7 @@ Core.projectionTypeName = (Core.Name "hydra.coders.Language"), Core.projectionFieldName = (Core.Name "defaultFileExtension")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the post variant of hydra.coders.TraversalOrder traversalOrderPost :: Typed.TypedTerm Coders.TraversalOrder traversalOrderPost = @@ -1890,6 +1970,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "post"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pre variant of hydra.coders.TraversalOrder traversalOrderPre :: Typed.TypedTerm Coders.TraversalOrder traversalOrderPre = @@ -1898,6 +1979,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pre"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL accessor for the body of hydra.coders.LanguageName unLanguageName :: Typed.TypedTerm Coders.LanguageName -> Typed.TypedTerm String unLanguageName x = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.core module Hydra.Dsl.Core where + import qualified Hydra.Core as Core import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) @@ -10,6 +12,7 @@ import qualified Data.Int as I import qualified Data.Map as M import qualified Data.Set as S + -- | DSL constructor for hydra.core.AnnotatedTerm annotatedTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.AnnotatedTerm annotatedTerm body annotation = @@ -22,6 +25,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm annotation)}]})) + -- | DSL accessor for the annotation field of hydra.core.AnnotatedTerm annotatedTermAnnotation :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term annotatedTermAnnotation x = @@ -30,6 +34,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedTerm"), Core.projectionFieldName = (Core.Name "annotation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body field of hydra.core.AnnotatedTerm annotatedTermBody :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term annotatedTermBody x = @@ -38,6 +43,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedTerm"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the annotation field of hydra.core.AnnotatedTerm annotatedTermWithAnnotation :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.AnnotatedTerm annotatedTermWithAnnotation original newVal = @@ -54,6 +60,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the body field of hydra.core.AnnotatedTerm annotatedTermWithBody :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.AnnotatedTerm annotatedTermWithBody original newVal = @@ -70,6 +77,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedTerm"), Core.projectionFieldName = (Core.Name "annotation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.AnnotatedType annotatedType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.AnnotatedType annotatedType body annotation = @@ -82,6 +90,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm annotation)}]})) + -- | DSL accessor for the annotation field of hydra.core.AnnotatedType annotatedTypeAnnotation :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Term annotatedTypeAnnotation x = @@ -90,6 +99,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedType"), Core.projectionFieldName = (Core.Name "annotation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body field of hydra.core.AnnotatedType annotatedTypeBody :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Type annotatedTypeBody x = @@ -98,6 +108,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedType"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the annotation field of hydra.core.AnnotatedType annotatedTypeWithAnnotation :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.AnnotatedType annotatedTypeWithAnnotation original newVal = @@ -114,6 +125,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the body field of hydra.core.AnnotatedType annotatedTypeWithBody :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.AnnotatedType annotatedTypeWithBody original newVal = @@ -130,6 +142,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.AnnotatedType"), Core.projectionFieldName = (Core.Name "annotation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.Application application :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Application application function argument = @@ -142,6 +155,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm argument)}]})) + -- | DSL accessor for the argument field of hydra.core.Application applicationArgument :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term applicationArgument x = @@ -150,6 +164,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Application"), Core.projectionFieldName = (Core.Name "argument")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the function field of hydra.core.Application applicationFunction :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term applicationFunction x = @@ -158,6 +173,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Application"), Core.projectionFieldName = (Core.Name "function")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.core.ApplicationType applicationType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ApplicationType applicationType function argument = @@ -170,6 +186,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm argument)}]})) + -- | DSL accessor for the argument field of hydra.core.ApplicationType applicationTypeArgument :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type applicationTypeArgument x = @@ -178,6 +195,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ApplicationType"), Core.projectionFieldName = (Core.Name "argument")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the function field of hydra.core.ApplicationType applicationTypeFunction :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type applicationTypeFunction x = @@ -186,6 +204,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ApplicationType"), Core.projectionFieldName = (Core.Name "function")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the argument field of hydra.core.ApplicationType applicationTypeWithArgument :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ApplicationType applicationTypeWithArgument original newVal = @@ -202,6 +221,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the function field of hydra.core.ApplicationType applicationTypeWithFunction :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ApplicationType applicationTypeWithFunction original newVal = @@ -218,6 +238,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ApplicationType"), Core.projectionFieldName = (Core.Name "argument")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the argument field of hydra.core.Application applicationWithArgument :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Application applicationWithArgument original newVal = @@ -234,6 +255,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the function field of hydra.core.Application applicationWithFunction :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Application applicationWithFunction original newVal = @@ -250,6 +272,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Application"), Core.projectionFieldName = (Core.Name "argument")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.Binding binding :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Maybe Core.TypeScheme) -> Typed.TypedTerm Core.Binding binding name term typeScheme = @@ -265,6 +288,7 @@ Core.Field { Core.fieldName = (Core.Name "typeScheme"), Core.fieldTerm = (Typed.unTypedTerm typeScheme)}]})) + -- | DSL accessor for the name field of hydra.core.Binding bindingName :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Core.Name bindingName x = @@ -273,6 +297,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Binding"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the term field of hydra.core.Binding bindingTerm :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Core.Term bindingTerm x = @@ -281,6 +306,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Binding"), Core.projectionFieldName = (Core.Name "term")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeScheme field of hydra.core.Binding bindingTypeScheme :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm (Maybe Core.TypeScheme) bindingTypeScheme x = @@ -289,6 +315,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Binding"), Core.projectionFieldName = (Core.Name "typeScheme")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.core.Binding bindingWithName :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Binding bindingWithName original newVal = @@ -312,6 +339,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Binding"), Core.projectionFieldName = (Core.Name "typeScheme")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the term field of hydra.core.Binding bindingWithTerm :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Binding bindingWithTerm original newVal = @@ -335,6 +363,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Binding"), Core.projectionFieldName = (Core.Name "typeScheme")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeScheme field of hydra.core.Binding bindingWithTypeScheme :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm (Maybe Core.TypeScheme) -> Typed.TypedTerm Core.Binding bindingWithTypeScheme original newVal = @@ -358,6 +387,7 @@ Core.Field { Core.fieldName = (Core.Name "typeScheme"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.core.CaseAlternative caseAlternative :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.CaseAlternative caseAlternative name handler = @@ -370,6 +400,7 @@ Core.Field { Core.fieldName = (Core.Name "handler"), Core.fieldTerm = (Typed.unTypedTerm handler)}]})) + -- | DSL accessor for the handler field of hydra.core.CaseAlternative caseAlternativeHandler :: Typed.TypedTerm Core.CaseAlternative -> Typed.TypedTerm Core.Term caseAlternativeHandler x = @@ -378,6 +409,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseAlternative"), Core.projectionFieldName = (Core.Name "handler")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.core.CaseAlternative caseAlternativeName :: Typed.TypedTerm Core.CaseAlternative -> Typed.TypedTerm Core.Name caseAlternativeName x = @@ -386,6 +418,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseAlternative"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the handler field of hydra.core.CaseAlternative caseAlternativeWithHandler :: Typed.TypedTerm Core.CaseAlternative -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.CaseAlternative caseAlternativeWithHandler original newVal = @@ -402,6 +435,7 @@ Core.Field { Core.fieldName = (Core.Name "handler"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.core.CaseAlternative caseAlternativeWithName :: Typed.TypedTerm Core.CaseAlternative -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.CaseAlternative caseAlternativeWithName original newVal = @@ -418,6 +452,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseAlternative"), Core.projectionFieldName = (Core.Name "handler")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.CaseStatement caseStatement :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm [Core.CaseAlternative] -> Typed.TypedTerm Core.CaseStatement caseStatement typeName default_ cases = @@ -433,6 +468,7 @@ Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm cases)}]})) + -- | DSL accessor for the cases field of hydra.core.CaseStatement caseStatementCases :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm [Core.CaseAlternative] caseStatementCases x = @@ -441,6 +477,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseStatement"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the default field of hydra.core.CaseStatement caseStatementDefault :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm (Maybe Core.Term) caseStatementDefault x = @@ -449,6 +486,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseStatement"), Core.projectionFieldName = (Core.Name "default")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.core.CaseStatement caseStatementTypeName :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm Core.Name caseStatementTypeName x = @@ -457,6 +495,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseStatement"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the cases field of hydra.core.CaseStatement caseStatementWithCases :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm [Core.CaseAlternative] -> Typed.TypedTerm Core.CaseStatement caseStatementWithCases original newVal = @@ -480,6 +519,7 @@ Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the default field of hydra.core.CaseStatement caseStatementWithDefault :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Core.CaseStatement caseStatementWithDefault original newVal = @@ -503,6 +543,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseStatement"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeName field of hydra.core.CaseStatement caseStatementWithTypeName :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.CaseStatement caseStatementWithTypeName original newVal = @@ -526,6 +567,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.CaseStatement"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.EitherType eitherType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.EitherType eitherType left right = @@ -538,6 +580,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm right)}]})) + -- | DSL accessor for the left field of hydra.core.EitherType eitherTypeLeft :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type eitherTypeLeft x = @@ -546,6 +589,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.EitherType"), Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the right field of hydra.core.EitherType eitherTypeRight :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type eitherTypeRight x = @@ -554,6 +598,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.EitherType"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the left field of hydra.core.EitherType eitherTypeWithLeft :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.EitherType eitherTypeWithLeft original newVal = @@ -570,6 +615,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.EitherType"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the right field of hydra.core.EitherType eitherTypeWithRight :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.EitherType eitherTypeWithRight original newVal = @@ -586,6 +632,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.core.Field field :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Field field name term = @@ -598,6 +645,7 @@ Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm term)}]})) + -- | DSL accessor for the name field of hydra.core.Field fieldName :: Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Name fieldName x = @@ -606,6 +654,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Field"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the term field of hydra.core.Field fieldTerm :: Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Term fieldTerm x = @@ -614,6 +663,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Field"), Core.projectionFieldName = (Core.Name "term")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.core.FieldType fieldType :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.FieldType fieldType name type_ = @@ -626,6 +676,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the name field of hydra.core.FieldType fieldTypeName :: Typed.TypedTerm Core.FieldType -> Typed.TypedTerm Core.Name fieldTypeName x = @@ -634,6 +685,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FieldType"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.core.FieldType fieldTypeType :: Typed.TypedTerm Core.FieldType -> Typed.TypedTerm Core.Type fieldTypeType x = @@ -642,6 +694,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FieldType"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.core.FieldType fieldTypeWithName :: Typed.TypedTerm Core.FieldType -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.FieldType fieldTypeWithName original newVal = @@ -658,6 +711,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FieldType"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.core.FieldType fieldTypeWithType :: Typed.TypedTerm Core.FieldType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.FieldType fieldTypeWithType original newVal = @@ -674,6 +728,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.core.Field fieldWithName :: Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Field fieldWithName original newVal = @@ -690,6 +745,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Field"), Core.projectionFieldName = (Core.Name "term")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the term field of hydra.core.Field fieldWithTerm :: Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Field fieldWithTerm original newVal = @@ -706,6 +762,7 @@ Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the float32 variant of hydra.core.FloatType floatTypeFloat32 :: Typed.TypedTerm Core.FloatType floatTypeFloat32 = @@ -714,6 +771,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float32"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the float64 variant of hydra.core.FloatType floatTypeFloat64 :: Typed.TypedTerm Core.FloatType floatTypeFloat64 = @@ -722,6 +780,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float64"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the float32 variant of hydra.core.FloatValue floatValueFloat32 :: Typed.TypedTerm Float -> Typed.TypedTerm Core.FloatValue floatValueFloat32 x = @@ -730,6 +789,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float32"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the float64 variant of hydra.core.FloatValue floatValueFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Core.FloatValue floatValueFloat64 x = @@ -738,6 +798,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float64"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.ForallType forallType :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ForallType forallType parameter body = @@ -750,6 +811,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.core.ForallType forallTypeBody :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Type forallTypeBody x = @@ -758,6 +820,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ForallType"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the parameter field of hydra.core.ForallType forallTypeParameter :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Name forallTypeParameter x = @@ -766,6 +829,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ForallType"), Core.projectionFieldName = (Core.Name "parameter")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the body field of hydra.core.ForallType forallTypeWithBody :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.ForallType forallTypeWithBody original newVal = @@ -782,6 +846,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the parameter field of hydra.core.ForallType forallTypeWithParameter :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.ForallType forallTypeWithParameter original newVal = @@ -798,6 +863,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.ForallType"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.FunctionType functionType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.FunctionType functionType domain codomain = @@ -810,6 +876,7 @@ Core.Field { Core.fieldName = (Core.Name "codomain"), Core.fieldTerm = (Typed.unTypedTerm codomain)}]})) + -- | DSL accessor for the codomain field of hydra.core.FunctionType functionTypeCodomain :: Typed.TypedTerm Core.FunctionType -> Typed.TypedTerm Core.Type functionTypeCodomain x = @@ -818,6 +885,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FunctionType"), Core.projectionFieldName = (Core.Name "codomain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the domain field of hydra.core.FunctionType functionTypeDomain :: Typed.TypedTerm Core.FunctionType -> Typed.TypedTerm Core.Type functionTypeDomain x = @@ -826,6 +894,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FunctionType"), Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -842,6 +911,7 @@ Core.Field { Core.fieldName = (Core.Name "codomain"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the domain field of hydra.core.FunctionType functionTypeWithDomain :: Typed.TypedTerm Core.FunctionType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.FunctionType functionTypeWithDomain original newVal = @@ -858,6 +928,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.FunctionType"), Core.projectionFieldName = (Core.Name "codomain")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.Injection injection :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Injection injection typeName field = @@ -870,6 +941,7 @@ Core.Field { Core.fieldName = (Core.Name "field"), Core.fieldTerm = (Typed.unTypedTerm field)}]})) + -- | DSL accessor for the field field of hydra.core.Injection injectionField :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Field injectionField x = @@ -878,6 +950,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Injection"), Core.projectionFieldName = (Core.Name "field")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.core.Injection injectionTypeName :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Name injectionTypeName x = @@ -886,6 +959,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Injection"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the field field of hydra.core.Injection injectionWithField :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Field -> Typed.TypedTerm Core.Injection injectionWithField original newVal = @@ -902,6 +976,7 @@ Core.Field { Core.fieldName = (Core.Name "field"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the typeName field of hydra.core.Injection injectionWithTypeName :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Injection injectionWithTypeName original newVal = @@ -918,6 +993,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Injection"), Core.projectionFieldName = (Core.Name "field")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the bigint variant of hydra.core.IntegerType integerTypeBigint :: Typed.TypedTerm Core.IntegerType integerTypeBigint = @@ -926,6 +1002,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "bigint"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the int16 variant of hydra.core.IntegerType integerTypeInt16 :: Typed.TypedTerm Core.IntegerType integerTypeInt16 = @@ -934,6 +1011,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int16"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the int32 variant of hydra.core.IntegerType integerTypeInt32 :: Typed.TypedTerm Core.IntegerType integerTypeInt32 = @@ -942,6 +1020,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int32"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the int64 variant of hydra.core.IntegerType integerTypeInt64 :: Typed.TypedTerm Core.IntegerType integerTypeInt64 = @@ -950,6 +1029,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int64"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the int8 variant of hydra.core.IntegerType integerTypeInt8 :: Typed.TypedTerm Core.IntegerType integerTypeInt8 = @@ -958,6 +1038,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int8"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the uint16 variant of hydra.core.IntegerType integerTypeUint16 :: Typed.TypedTerm Core.IntegerType integerTypeUint16 = @@ -966,6 +1047,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint16"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the uint32 variant of hydra.core.IntegerType integerTypeUint32 :: Typed.TypedTerm Core.IntegerType integerTypeUint32 = @@ -974,6 +1056,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint32"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the uint64 variant of hydra.core.IntegerType integerTypeUint64 :: Typed.TypedTerm Core.IntegerType integerTypeUint64 = @@ -982,6 +1065,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint64"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the uint8 variant of hydra.core.IntegerType integerTypeUint8 :: Typed.TypedTerm Core.IntegerType integerTypeUint8 = @@ -990,6 +1074,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint8"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the bigint variant of hydra.core.IntegerValue integerValueBigint :: Typed.TypedTerm Integer -> Typed.TypedTerm Core.IntegerValue integerValueBigint x = @@ -998,6 +1083,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "bigint"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the int16 variant of hydra.core.IntegerValue integerValueInt16 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Core.IntegerValue integerValueInt16 x = @@ -1006,6 +1092,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int16"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the int32 variant of hydra.core.IntegerValue integerValueInt32 :: Typed.TypedTerm Int -> Typed.TypedTerm Core.IntegerValue integerValueInt32 x = @@ -1014,6 +1101,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int32"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the int64 variant of hydra.core.IntegerValue integerValueInt64 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Core.IntegerValue integerValueInt64 x = @@ -1022,6 +1110,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int64"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the int8 variant of hydra.core.IntegerValue integerValueInt8 :: Typed.TypedTerm I.Int8 -> Typed.TypedTerm Core.IntegerValue integerValueInt8 x = @@ -1030,6 +1119,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int8"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the uint16 variant of hydra.core.IntegerValue integerValueUint16 :: Typed.TypedTerm Int -> Typed.TypedTerm Core.IntegerValue integerValueUint16 x = @@ -1038,6 +1128,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint16"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the uint32 variant of hydra.core.IntegerValue integerValueUint32 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Core.IntegerValue integerValueUint32 x = @@ -1046,6 +1137,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint32"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the uint64 variant of hydra.core.IntegerValue integerValueUint64 :: Typed.TypedTerm Integer -> Typed.TypedTerm Core.IntegerValue integerValueUint64 x = @@ -1054,6 +1146,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint64"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the uint8 variant of hydra.core.IntegerValue integerValueUint8 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Core.IntegerValue integerValueUint8 x = @@ -1062,6 +1155,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint8"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.Lambda lambda :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Type) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Lambda lambda parameter domain body = @@ -1077,6 +1171,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.core.Lambda lambdaBody :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Term lambdaBody x = @@ -1085,6 +1180,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Lambda"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the domain field of hydra.core.Lambda lambdaDomain :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm (Maybe Core.Type) lambdaDomain x = @@ -1093,6 +1189,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Lambda"), Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the parameter field of hydra.core.Lambda lambdaParameter :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Name lambdaParameter x = @@ -1101,6 +1198,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Lambda"), Core.projectionFieldName = (Core.Name "parameter")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the body field of hydra.core.Lambda lambdaWithBody :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Lambda lambdaWithBody original newVal = @@ -1124,6 +1222,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the domain field of hydra.core.Lambda lambdaWithDomain :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm (Maybe Core.Type) -> Typed.TypedTerm Core.Lambda lambdaWithDomain original newVal = @@ -1147,6 +1246,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Lambda"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the parameter field of hydra.core.Lambda lambdaWithParameter :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Lambda lambdaWithParameter original newVal = @@ -1170,6 +1270,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Lambda"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.Let let_ :: Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Let let_ bindings body = @@ -1182,6 +1283,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the bindings field of hydra.core.Let letBindings :: Typed.TypedTerm Core.Let -> Typed.TypedTerm [Core.Binding] letBindings x = @@ -1190,6 +1292,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Let"), Core.projectionFieldName = (Core.Name "bindings")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body field of hydra.core.Let letBody :: Typed.TypedTerm Core.Let -> Typed.TypedTerm Core.Term letBody x = @@ -1198,6 +1301,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Let"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1214,6 +1318,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Let"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the body field of hydra.core.Let letWithBody :: Typed.TypedTerm Core.Let -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Let letWithBody original newVal = @@ -1230,6 +1335,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the binary variant of hydra.core.Literal literalBinary :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm Core.Literal literalBinary x = @@ -1238,6 +1344,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "binary"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the boolean variant of hydra.core.Literal literalBoolean :: Typed.TypedTerm Bool -> Typed.TypedTerm Core.Literal literalBoolean x = @@ -1246,6 +1353,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "boolean"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the decimal variant of hydra.core.Literal literalDecimal :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Core.Literal literalDecimal x = @@ -1254,6 +1362,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decimal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the float variant of hydra.core.Literal literalFloat :: Typed.TypedTerm Core.FloatValue -> Typed.TypedTerm Core.Literal literalFloat x = @@ -1262,6 +1371,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the integer variant of hydra.core.Literal literalInteger :: Typed.TypedTerm Core.IntegerValue -> Typed.TypedTerm Core.Literal literalInteger x = @@ -1270,6 +1380,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "integer"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the string variant of hydra.core.Literal literalString :: Typed.TypedTerm String -> Typed.TypedTerm Core.Literal literalString x = @@ -1278,6 +1389,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the binary variant of hydra.core.LiteralType literalTypeBinary :: Typed.TypedTerm Core.LiteralType literalTypeBinary = @@ -1286,6 +1398,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "binary"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the boolean variant of hydra.core.LiteralType literalTypeBoolean :: Typed.TypedTerm Core.LiteralType literalTypeBoolean = @@ -1294,6 +1407,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "boolean"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the decimal variant of hydra.core.LiteralType literalTypeDecimal :: Typed.TypedTerm Core.LiteralType literalTypeDecimal = @@ -1302,6 +1416,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decimal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the float variant of hydra.core.LiteralType literalTypeFloat :: Typed.TypedTerm Core.FloatType -> Typed.TypedTerm Core.LiteralType literalTypeFloat x = @@ -1310,6 +1425,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the integer variant of hydra.core.LiteralType literalTypeInteger :: Typed.TypedTerm Core.IntegerType -> Typed.TypedTerm Core.LiteralType literalTypeInteger x = @@ -1318,6 +1434,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "integer"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the string variant of hydra.core.LiteralType literalTypeString :: Typed.TypedTerm Core.LiteralType literalTypeString = @@ -1326,6 +1443,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.core.MapType mapType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.MapType mapType keys values = @@ -1338,6 +1456,7 @@ Core.Field { Core.fieldName = (Core.Name "values"), Core.fieldTerm = (Typed.unTypedTerm values)}]})) + -- | DSL accessor for the keys field of hydra.core.MapType mapTypeKeys :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type mapTypeKeys x = @@ -1346,6 +1465,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.MapType"), Core.projectionFieldName = (Core.Name "keys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the values field of hydra.core.MapType mapTypeValues :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type mapTypeValues x = @@ -1354,6 +1474,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.MapType"), Core.projectionFieldName = (Core.Name "values")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the keys field of hydra.core.MapType mapTypeWithKeys :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.MapType mapTypeWithKeys original newVal = @@ -1370,6 +1491,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.MapType"), Core.projectionFieldName = (Core.Name "values")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the values field of hydra.core.MapType mapTypeWithValues :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.MapType mapTypeWithValues original newVal = @@ -1386,12 +1508,14 @@ Core.Field { Core.fieldName = (Core.Name "values"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.core.Name wrapper name :: Typed.TypedTerm String -> Typed.TypedTerm Core.Name name x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.core.PairType pairType :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.PairType pairType first second = @@ -1404,6 +1528,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (Typed.unTypedTerm second)}]})) + -- | DSL accessor for the first field of hydra.core.PairType pairTypeFirst :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type pairTypeFirst x = @@ -1412,6 +1537,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.PairType"), Core.projectionFieldName = (Core.Name "first")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the second field of hydra.core.PairType pairTypeSecond :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type pairTypeSecond x = @@ -1420,6 +1546,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.PairType"), Core.projectionFieldName = (Core.Name "second")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the first field of hydra.core.PairType pairTypeWithFirst :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.PairType pairTypeWithFirst original newVal = @@ -1436,6 +1563,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.PairType"), Core.projectionFieldName = (Core.Name "second")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the second field of hydra.core.PairType pairTypeWithSecond :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.PairType pairTypeWithSecond original newVal = @@ -1452,6 +1580,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.core.Projection projection :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Projection projection typeName fieldName = @@ -1464,6 +1593,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm fieldName)}]})) + -- | DSL accessor for the fieldName field of hydra.core.Projection projectionFieldName :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Name projectionFieldName x = @@ -1472,6 +1602,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Projection"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.core.Projection projectionTypeName :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Name projectionTypeName x = @@ -1480,6 +1611,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Projection"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the fieldName field of hydra.core.Projection projectionWithFieldName :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Projection projectionWithFieldName original newVal = @@ -1496,6 +1628,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the typeName field of hydra.core.Projection projectionWithTypeName :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Projection projectionWithTypeName original newVal = @@ -1512,6 +1645,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Projection"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.core.Record record :: Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Field] -> Typed.TypedTerm Core.Record record typeName fields = @@ -1524,6 +1658,7 @@ Core.Field { Core.fieldName = (Core.Name "fields"), Core.fieldTerm = (Typed.unTypedTerm fields)}]})) + -- | DSL accessor for the fields field of hydra.core.Record recordFields :: Typed.TypedTerm Core.Record -> Typed.TypedTerm [Core.Field] recordFields x = @@ -1532,6 +1667,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Record"), Core.projectionFieldName = (Core.Name "fields")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.core.Record recordTypeName :: Typed.TypedTerm Core.Record -> Typed.TypedTerm Core.Name recordTypeName x = @@ -1540,6 +1676,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Record"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the fields field of hydra.core.Record recordWithFields :: Typed.TypedTerm Core.Record -> Typed.TypedTerm [Core.Field] -> Typed.TypedTerm Core.Record recordWithFields original newVal = @@ -1556,6 +1693,7 @@ Core.Field { Core.fieldName = (Core.Name "fields"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the typeName field of hydra.core.Record recordWithTypeName :: Typed.TypedTerm Core.Record -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Record recordWithTypeName original newVal = @@ -1572,6 +1710,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.Record"), Core.projectionFieldName = (Core.Name "fields")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the annotated variant of hydra.core.Term termAnnotated :: Typed.TypedTerm Core.AnnotatedTerm -> Typed.TypedTerm Core.Term termAnnotated x = @@ -1580,6 +1719,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotated"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the application variant of hydra.core.Term termApplication :: Typed.TypedTerm Core.Application -> Typed.TypedTerm Core.Term termApplication x = @@ -1588,6 +1728,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the cases variant of hydra.core.Term termCases :: Typed.TypedTerm Core.CaseStatement -> Typed.TypedTerm Core.Term termCases x = @@ -1596,6 +1737,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the either variant of hydra.core.Term termEither :: Typed.TypedTerm (Either Core.Term Core.Term) -> Typed.TypedTerm Core.Term termEither x = @@ -1604,6 +1746,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "either"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the inject variant of hydra.core.Term termInject :: Typed.TypedTerm Core.Injection -> Typed.TypedTerm Core.Term termInject x = @@ -1612,6 +1755,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "inject"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the lambda variant of hydra.core.Term termLambda :: Typed.TypedTerm Core.Lambda -> Typed.TypedTerm Core.Term termLambda x = @@ -1620,6 +1764,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lambda"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the let variant of hydra.core.Term termLet :: Typed.TypedTerm Core.Let -> Typed.TypedTerm Core.Term termLet x = @@ -1628,6 +1773,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "let"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the list variant of hydra.core.Term termList :: Typed.TypedTerm [Core.Term] -> Typed.TypedTerm Core.Term termList x = @@ -1636,6 +1782,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "list"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the literal variant of hydra.core.Term termLiteral :: Typed.TypedTerm Core.Literal -> Typed.TypedTerm Core.Term termLiteral x = @@ -1644,6 +1791,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "literal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the map variant of hydra.core.Term termMap :: Typed.TypedTerm (M.Map Core.Term Core.Term) -> Typed.TypedTerm Core.Term termMap x = @@ -1652,6 +1800,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "map"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the optional variant of hydra.core.Term termOptional :: Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Core.Term termOptional x = @@ -1660,6 +1809,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optional"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the pair variant of hydra.core.Term termPair :: Typed.TypedTerm (Core.Term, Core.Term) -> Typed.TypedTerm Core.Term termPair x = @@ -1668,6 +1818,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pair"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the project variant of hydra.core.Term termProject :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Core.Term termProject x = @@ -1676,6 +1827,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "project"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the record variant of hydra.core.Term termRecord :: Typed.TypedTerm Core.Record -> Typed.TypedTerm Core.Term termRecord x = @@ -1684,6 +1836,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "record"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the set variant of hydra.core.Term termSet :: Typed.TypedTerm (S.Set Core.Term) -> Typed.TypedTerm Core.Term termSet x = @@ -1692,6 +1845,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeApplication variant of hydra.core.Term termTypeApplication :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Term termTypeApplication x = @@ -1700,6 +1854,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeApplication"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeLambda variant of hydra.core.Term termTypeLambda :: Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Core.Term termTypeLambda x = @@ -1708,6 +1863,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeLambda"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unit variant of hydra.core.Term termUnit :: Typed.TypedTerm Core.Term termUnit = @@ -1716,6 +1872,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unit"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unwrap variant of hydra.core.Term termUnwrap :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term termUnwrap x = @@ -1724,6 +1881,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unwrap"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the variable variant of hydra.core.Term termVariable :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term termVariable x = @@ -1732,6 +1890,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the wrap variant of hydra.core.Term termWrap :: Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm Core.Term termWrap x = @@ -1740,6 +1899,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the annotated variant of hydra.core.Type typeAnnotated :: Typed.TypedTerm Core.AnnotatedType -> Typed.TypedTerm Core.Type typeAnnotated x = @@ -1748,6 +1908,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotated"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the application variant of hydra.core.Type typeApplication :: Typed.TypedTerm Core.ApplicationType -> Typed.TypedTerm Core.Type typeApplication x = @@ -1756,6 +1917,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.TypeApplicationTerm typeApplicationTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.TypeApplicationTerm typeApplicationTerm body type_ = @@ -1768,6 +1930,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the body field of hydra.core.TypeApplicationTerm typeApplicationTermBody :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Term typeApplicationTermBody x = @@ -1776,6 +1939,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeApplicationTerm"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.core.TypeApplicationTerm typeApplicationTermType :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Type typeApplicationTermType x = @@ -1784,6 +1948,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeApplicationTerm"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1800,6 +1965,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeApplicationTerm"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.core.TypeApplicationTerm typeApplicationTermWithType :: Typed.TypedTerm Core.TypeApplicationTerm -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.TypeApplicationTerm typeApplicationTermWithType original newVal = @@ -1816,6 +1982,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the simple variant of hydra.core.TypeClassConstraint typeClassConstraintSimple :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.TypeClassConstraint typeClassConstraintSimple x = @@ -1824,6 +1991,16 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "simple"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the effect variant of hydra.core.Type +typeEffect :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type +typeEffect x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Type"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "effect"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the either variant of hydra.core.Type typeEither :: Typed.TypedTerm Core.EitherType -> Typed.TypedTerm Core.Type typeEither x = @@ -1832,6 +2009,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "either"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the forall variant of hydra.core.Type typeForall :: Typed.TypedTerm Core.ForallType -> Typed.TypedTerm Core.Type typeForall x = @@ -1840,6 +2018,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "forall"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the function variant of hydra.core.Type typeFunction :: Typed.TypedTerm Core.FunctionType -> Typed.TypedTerm Core.Type typeFunction x = @@ -1848,6 +2027,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "function"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.TypeLambda typeLambda :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.TypeLambda typeLambda parameter body = @@ -1860,6 +2040,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.core.TypeLambda typeLambdaBody :: Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Core.Term typeLambdaBody x = @@ -1868,6 +2049,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeLambda"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the parameter field of hydra.core.TypeLambda typeLambdaParameter :: Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Core.Name typeLambdaParameter x = @@ -1876,6 +2058,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeLambda"), Core.projectionFieldName = (Core.Name "parameter")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1892,6 +2075,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the parameter field of hydra.core.TypeLambda typeLambdaWithParameter :: Typed.TypedTerm Core.TypeLambda -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.TypeLambda typeLambdaWithParameter original newVal = @@ -1908,6 +2092,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeLambda"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the list variant of hydra.core.Type typeList :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type typeList x = @@ -1916,6 +2101,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "list"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the literal variant of hydra.core.Type typeLiteral :: Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm Core.Type typeLiteral x = @@ -1924,6 +2110,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "literal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the map variant of hydra.core.Type typeMap :: Typed.TypedTerm Core.MapType -> Typed.TypedTerm Core.Type typeMap x = @@ -1932,6 +2119,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "map"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the optional variant of hydra.core.Type typeOptional :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type typeOptional x = @@ -1940,6 +2128,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optional"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the pair variant of hydra.core.Type typePair :: Typed.TypedTerm Core.PairType -> Typed.TypedTerm Core.Type typePair x = @@ -1948,6 +2137,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pair"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the record variant of hydra.core.Type typeRecord :: Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm Core.Type typeRecord x = @@ -1956,6 +2146,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "record"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.TypeScheme typeScheme :: Typed.TypedTerm [Core.Name] -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Maybe (M.Map Core.Name Core.TypeVariableConstraints)) -> Typed.TypedTerm Core.TypeScheme typeScheme variables body constraints = @@ -1971,6 +2162,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = (Typed.unTypedTerm constraints)}]})) + -- | DSL accessor for the body field of hydra.core.TypeScheme typeSchemeBody :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Core.Type typeSchemeBody x = @@ -1979,6 +2171,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeScheme"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the constraints field of hydra.core.TypeScheme typeSchemeConstraints :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm (Maybe (M.Map Core.Name Core.TypeVariableConstraints)) typeSchemeConstraints x = @@ -1987,6 +2180,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeScheme"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the variables field of hydra.core.TypeScheme typeSchemeVariables :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm [Core.Name] typeSchemeVariables x = @@ -1995,6 +2189,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeScheme"), Core.projectionFieldName = (Core.Name "variables")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the body field of hydra.core.TypeScheme typeSchemeWithBody :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.TypeScheme typeSchemeWithBody original newVal = @@ -2018,6 +2213,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeScheme"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the constraints field of hydra.core.TypeScheme typeSchemeWithConstraints :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm (Maybe (M.Map Core.Name Core.TypeVariableConstraints)) -> Typed.TypedTerm Core.TypeScheme typeSchemeWithConstraints original newVal = @@ -2041,6 +2237,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the variables field of hydra.core.TypeScheme typeSchemeWithVariables :: Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm Core.TypeScheme typeSchemeWithVariables original newVal = @@ -2064,6 +2261,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeScheme"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the set variant of hydra.core.Type typeSet :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type typeSet x = @@ -2072,6 +2270,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the union variant of hydra.core.Type typeUnion :: Typed.TypedTerm [Core.FieldType] -> Typed.TypedTerm Core.Type typeUnion x = @@ -2080,6 +2279,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "union"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unit variant of hydra.core.Type typeUnit :: Typed.TypedTerm Core.Type typeUnit = @@ -2088,6 +2288,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unit"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the variable variant of hydra.core.Type typeVariable :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type typeVariable x = @@ -2096,6 +2297,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.core.TypeVariableConstraints typeVariableConstraints :: Typed.TypedTerm [Core.TypeClassConstraint] -> Typed.TypedTerm Core.TypeVariableConstraints typeVariableConstraints classes = @@ -2105,6 +2307,7 @@ Core.Field { Core.fieldName = (Core.Name "classes"), Core.fieldTerm = (Typed.unTypedTerm classes)}]})) + -- | DSL accessor for the classes field of hydra.core.TypeVariableConstraints typeVariableConstraintsClasses :: Typed.TypedTerm Core.TypeVariableConstraints -> Typed.TypedTerm [Core.TypeClassConstraint] typeVariableConstraintsClasses x = @@ -2113,6 +2316,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.TypeVariableConstraints"), Core.projectionFieldName = (Core.Name "classes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2122,6 +2326,7 @@ Core.Field { Core.fieldName = (Core.Name "classes"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the void variant of hydra.core.Type typeVoid :: Typed.TypedTerm Core.Type typeVoid = @@ -2130,6 +2335,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "void"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the wrap variant of hydra.core.Type typeWrap :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type typeWrap x = @@ -2138,12 +2344,14 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL accessor for the body of hydra.core.Name unName :: Typed.TypedTerm Core.Name -> Typed.TypedTerm String unName x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.core.Name")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.core.WrappedTerm wrappedTerm :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.WrappedTerm wrappedTerm typeName body = @@ -2156,6 +2364,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.core.WrappedTerm wrappedTermBody :: Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm Core.Term wrappedTermBody x = @@ -2164,6 +2373,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.WrappedTerm"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.core.WrappedTerm wrappedTermTypeName :: Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm Core.Name wrappedTermTypeName x = @@ -2172,6 +2382,7 @@ Core.projectionTypeName = (Core.Name "hydra.core.WrappedTerm"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the body field of hydra.core.WrappedTerm wrappedTermWithBody :: Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.WrappedTerm wrappedTermWithBody original newVal = @@ -2188,6 +2399,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the typeName field of hydra.core.WrappedTerm wrappedTermWithTypeName :: Typed.TypedTerm Core.WrappedTerm -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.WrappedTerm wrappedTermWithTypeName original newVal = diff --git a/src/main/haskell/Hydra/Dsl/Deep/Lib/Math.hs b/src/main/haskell/Hydra/Dsl/Deep/Lib/Math.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Deep/Lib/Math.hs +++ /dev/null @@ -1,131 +0,0 @@ --- | Deep term DSL for the hydra.lib.math library. --- --- These helpers construct Term-valued representations of math primitive --- applications (TypedTerm Term), as opposed to the shallow DSL in --- Hydra.Dsl.Meta.Lib.Math which works at the Haskell value level (TypedTerm Double, etc.). - -module Hydra.Dsl.Deep.Lib.Math where - -import Hydra.Kernel -import qualified Hydra.Dsl.Meta.Core as Core -import Hydra.Dsl.Meta.Phantoms (encodedName) -import Hydra.Dsl.Terms (ToPrimName(..)) -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Math as DefMath - - --- | Apply a unary math primitive to a deep term -apply1 :: ToPrimName n => n -> TypedTerm Term -> TypedTerm Term -apply1 n arg = Core.termApplication $ Core.application (Core.termVariable $ encodedName $ toPrimName n) arg - --- | Apply a binary math primitive to two deep terms -apply2 :: ToPrimName n => n -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -apply2 n a b = Core.termApplication $ Core.application - (Core.termApplication $ Core.application (Core.termVariable $ encodedName $ toPrimName n) a) - b - --- | Reference a math primitive as a deep term (for use as a first-class value) -ref :: ToPrimName n => n -> TypedTerm Term -ref = Core.termVariable . encodedName . toPrimName - - --- Unary functions - -abs :: TypedTerm Term -> TypedTerm Term -abs = apply1 (Prims.primName DefMath.abs) - -acos :: TypedTerm Term -> TypedTerm Term -acos = apply1 (Prims.primName DefMath.acos) - -acosh :: TypedTerm Term -> TypedTerm Term -acosh = apply1 (Prims.primName DefMath.acosh) - -asin :: TypedTerm Term -> TypedTerm Term -asin = apply1 (Prims.primName DefMath.asin) - -asinh :: TypedTerm Term -> TypedTerm Term -asinh = apply1 (Prims.primName DefMath.asinh) - -atan :: TypedTerm Term -> TypedTerm Term -atan = apply1 (Prims.primName DefMath.atan) - -atanh :: TypedTerm Term -> TypedTerm Term -atanh = apply1 (Prims.primName DefMath.atanh) - -ceiling :: TypedTerm Term -> TypedTerm Term -ceiling = apply1 (Prims.primName DefMath.ceiling) - -cos :: TypedTerm Term -> TypedTerm Term -cos = apply1 (Prims.primName DefMath.cos) - -cosh :: TypedTerm Term -> TypedTerm Term -cosh = apply1 (Prims.primName DefMath.cosh) - -exp :: TypedTerm Term -> TypedTerm Term -exp = apply1 (Prims.primName DefMath.exp) - -floor :: TypedTerm Term -> TypedTerm Term -floor = apply1 (Prims.primName DefMath.floor) - -log :: TypedTerm Term -> TypedTerm Term -log = apply1 (Prims.primName DefMath.log) - -negate :: TypedTerm Term -> TypedTerm Term -negate = apply1 (Prims.primName DefMath.negate) - -negateFloat64 :: TypedTerm Term -> TypedTerm Term -negateFloat64 = apply1 (Prims.primName DefMath.negateFloat64) - -round :: TypedTerm Term -> TypedTerm Term -round = apply1 (Prims.primName DefMath.round) - -signum :: TypedTerm Term -> TypedTerm Term -signum = apply1 (Prims.primName DefMath.signum) - -sin :: TypedTerm Term -> TypedTerm Term -sin = apply1 (Prims.primName DefMath.sin) - -sinh :: TypedTerm Term -> TypedTerm Term -sinh = apply1 (Prims.primName DefMath.sinh) - -sqrt :: TypedTerm Term -> TypedTerm Term -sqrt = apply1 (Prims.primName DefMath.sqrt) - -tan :: TypedTerm Term -> TypedTerm Term -tan = apply1 (Prims.primName DefMath.tan) - -tanh :: TypedTerm Term -> TypedTerm Term -tanh = apply1 (Prims.primName DefMath.tanh) - -truncate :: TypedTerm Term -> TypedTerm Term -truncate = apply1 (Prims.primName DefMath.truncate) - - --- Binary functions - -add :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -add = apply2 (Prims.primName DefMath.add) - -addFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -addFloat64 = apply2 (Prims.primName DefMath.addFloat64) - -atan2 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -atan2 = apply2 (Prims.primName DefMath.atan2) - -logBase :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -logBase = apply2 (Prims.primName DefMath.logBase) - -mul :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -mul = apply2 (Prims.primName DefMath.mul) - -mulFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -mulFloat64 = apply2 (Prims.primName DefMath.mulFloat64) - -pow :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -pow = apply2 (Prims.primName DefMath.pow) - -sub :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -sub = apply2 (Prims.primName DefMath.sub) - -subFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -subFloat64 = apply2 (Prims.primName DefMath.subFloat64) diff --git a/src/main/haskell/Hydra/Dsl/Docs.hs b/src/main/haskell/Hydra/Dsl/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Docs.hs @@ -0,0 +1,31 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.docs + +module Hydra.Dsl.Docs where + +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Dsl.Packaging as DslPackaging +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 injection for the ref variant of hydra.docs.DocSegment +docSegmentRef :: Typed.TypedTerm Packaging.EntityReference -> Typed.TypedTerm Docs.DocSegment +docSegmentRef x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.docs.DocSegment"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "ref"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the text variant of hydra.docs.DocSegment +docSegmentText :: Typed.TypedTerm String -> Typed.TypedTerm Docs.DocSegment +docSegmentText x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.docs.DocSegment"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "text"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.error.checking module Hydra.Dsl.Error.Checking where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths @@ -15,6 +17,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | DSL injection for the incorrectUnification variant of hydra.error.checking.CheckingError checkingErrorIncorrectUnification :: Typed.TypedTerm Checking.IncorrectUnificationError -> Typed.TypedTerm Checking.CheckingError checkingErrorIncorrectUnification x = @@ -23,6 +26,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "incorrectUnification"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the notAForallType variant of hydra.error.checking.CheckingError checkingErrorNotAForallType :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm Checking.CheckingError checkingErrorNotAForallType x = @@ -31,6 +35,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "notAForallType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the notAFunctionType variant of hydra.error.checking.CheckingError checkingErrorNotAFunctionType :: Typed.TypedTerm Checking.NotAFunctionTypeError -> Typed.TypedTerm Checking.CheckingError checkingErrorNotAFunctionType x = @@ -39,6 +44,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "notAFunctionType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the other variant of hydra.error.checking.CheckingError checkingErrorOther :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm Checking.CheckingError checkingErrorOther x = @@ -47,6 +53,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "other"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeArityMismatch variant of hydra.error.checking.CheckingError checkingErrorTypeArityMismatch :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Checking.CheckingError checkingErrorTypeArityMismatch x = @@ -55,6 +62,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeArityMismatch"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeMismatch variant of hydra.error.checking.CheckingError checkingErrorTypeMismatch :: Typed.TypedTerm Checking.TypeMismatchError -> Typed.TypedTerm Checking.CheckingError checkingErrorTypeMismatch x = @@ -63,6 +71,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeMismatch"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unboundTypeVariables variant of hydra.error.checking.CheckingError checkingErrorUnboundTypeVariables :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm Checking.CheckingError checkingErrorUnboundTypeVariables x = @@ -71,6 +80,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unboundTypeVariables"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTermVariable variant of hydra.error.checking.CheckingError checkingErrorUndefinedTermVariable :: Typed.TypedTerm Checking.UndefinedTermVariableCheckingError -> Typed.TypedTerm Checking.CheckingError checkingErrorUndefinedTermVariable x = @@ -79,6 +89,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unequalTypes variant of hydra.error.checking.CheckingError checkingErrorUnequalTypes :: Typed.TypedTerm Checking.UnequalTypesError -> Typed.TypedTerm Checking.CheckingError checkingErrorUnequalTypes x = @@ -87,6 +98,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unequalTypes"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unsupportedTermVariant variant of hydra.error.checking.CheckingError checkingErrorUnsupportedTermVariant :: Typed.TypedTerm Checking.UnsupportedTermVariantError -> Typed.TypedTerm Checking.CheckingError checkingErrorUnsupportedTermVariant x = @@ -95,6 +107,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unsupportedTermVariant"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the untypedLambda variant of hydra.error.checking.CheckingError checkingErrorUntypedLambda :: Typed.TypedTerm Checking.UntypedLambdaError -> Typed.TypedTerm Checking.CheckingError checkingErrorUntypedLambda x = @@ -103,6 +116,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedLambda"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the untypedLetBinding variant of hydra.error.checking.CheckingError checkingErrorUntypedLetBinding :: Typed.TypedTerm Checking.UntypedLetBindingError -> Typed.TypedTerm Checking.CheckingError checkingErrorUntypedLetBinding x = @@ -111,6 +125,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedLetBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the untypedTermVariable variant of hydra.error.checking.CheckingError checkingErrorUntypedTermVariable :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Checking.CheckingError checkingErrorUntypedTermVariable x = @@ -119,6 +134,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.error.checking.IncorrectUnificationError incorrectUnificationError :: Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm Checking.IncorrectUnificationError incorrectUnificationError substitution = @@ -128,6 +144,7 @@ Core.Field { Core.fieldName = (Core.Name "substitution"), Core.fieldTerm = (Typed.unTypedTerm substitution)}]})) + -- | DSL accessor for the substitution field of hydra.error.checking.IncorrectUnificationError incorrectUnificationErrorSubstitution :: Typed.TypedTerm Checking.IncorrectUnificationError -> Typed.TypedTerm Typing.TypeSubst incorrectUnificationErrorSubstitution x = @@ -136,6 +153,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.IncorrectUnificationError"), Core.projectionFieldName = (Core.Name "substitution")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the substitution field of hydra.error.checking.IncorrectUnificationError incorrectUnificationErrorWithSubstitution :: Typed.TypedTerm Checking.IncorrectUnificationError -> Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm Checking.IncorrectUnificationError incorrectUnificationErrorWithSubstitution original newVal = @@ -145,6 +163,7 @@ Core.Field { Core.fieldName = (Core.Name "substitution"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.NotAForallTypeError notAForallTypeError :: Typed.TypedTerm Core.Type -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Checking.NotAForallTypeError notAForallTypeError type_ typeArguments = @@ -157,6 +176,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = (Typed.unTypedTerm typeArguments)}]})) + -- | DSL accessor for the type field of hydra.error.checking.NotAForallTypeError notAForallTypeErrorType :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm Core.Type notAForallTypeErrorType x = @@ -165,6 +185,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.NotAForallTypeError"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeArguments field of hydra.error.checking.NotAForallTypeError notAForallTypeErrorTypeArguments :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm [Core.Type] notAForallTypeErrorTypeArguments x = @@ -173,6 +194,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.NotAForallTypeError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the type field of hydra.error.checking.NotAForallTypeError notAForallTypeErrorWithType :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.NotAForallTypeError notAForallTypeErrorWithType original newVal = @@ -189,6 +211,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.NotAForallTypeError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeArguments field of hydra.error.checking.NotAForallTypeError notAForallTypeErrorWithTypeArguments :: Typed.TypedTerm Checking.NotAForallTypeError -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Checking.NotAForallTypeError notAForallTypeErrorWithTypeArguments original newVal = @@ -205,6 +228,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.NotAFunctionTypeError notAFunctionTypeError :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.NotAFunctionTypeError notAFunctionTypeError type_ = @@ -214,6 +238,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the type field of hydra.error.checking.NotAFunctionTypeError notAFunctionTypeErrorType :: Typed.TypedTerm Checking.NotAFunctionTypeError -> Typed.TypedTerm Core.Type notAFunctionTypeErrorType x = @@ -222,6 +247,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.NotAFunctionTypeError"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the type field of hydra.error.checking.NotAFunctionTypeError notAFunctionTypeErrorWithType :: Typed.TypedTerm Checking.NotAFunctionTypeError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.NotAFunctionTypeError notAFunctionTypeErrorWithType original newVal = @@ -231,6 +257,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.OtherCheckingError otherCheckingError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm String -> Typed.TypedTerm Checking.OtherCheckingError otherCheckingError path message = @@ -243,6 +270,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm message)}]})) + -- | DSL accessor for the message field of hydra.error.checking.OtherCheckingError otherCheckingErrorMessage :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm String otherCheckingErrorMessage x = @@ -251,6 +279,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.OtherCheckingError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the path field of hydra.error.checking.OtherCheckingError otherCheckingErrorPath :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm Paths.SubtermPath otherCheckingErrorPath x = @@ -259,6 +288,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.OtherCheckingError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the message field of hydra.error.checking.OtherCheckingError otherCheckingErrorWithMessage :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm String -> Typed.TypedTerm Checking.OtherCheckingError otherCheckingErrorWithMessage original newVal = @@ -275,6 +305,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the path field of hydra.error.checking.OtherCheckingError otherCheckingErrorWithPath :: Typed.TypedTerm Checking.OtherCheckingError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Checking.OtherCheckingError otherCheckingErrorWithPath original newVal = @@ -291,6 +322,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.OtherCheckingError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.checking.TypeArityMismatchError typeArityMismatchError :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Checking.TypeArityMismatchError typeArityMismatchError type_ expectedArity actualArity typeArguments = @@ -309,6 +341,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = (Typed.unTypedTerm typeArguments)}]})) + -- | DSL accessor for the actualArity field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorActualArity :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Int typeArityMismatchErrorActualArity x = @@ -317,6 +350,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "actualArity")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expectedArity field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorExpectedArity :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Int typeArityMismatchErrorExpectedArity x = @@ -325,6 +359,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "expectedArity")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorType :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Core.Type typeArityMismatchErrorType x = @@ -333,6 +368,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeArguments field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorTypeArguments :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm [Core.Type] typeArityMismatchErrorTypeArguments x = @@ -341,6 +377,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -371,6 +408,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the expectedArity field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorWithExpectedArity :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Int -> Typed.TypedTerm Checking.TypeArityMismatchError typeArityMismatchErrorWithExpectedArity original newVal = @@ -401,6 +439,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorWithType :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.TypeArityMismatchError typeArityMismatchErrorWithType original newVal = @@ -431,6 +470,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeArityMismatchError"), Core.projectionFieldName = (Core.Name "typeArguments")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeArguments field of hydra.error.checking.TypeArityMismatchError typeArityMismatchErrorWithTypeArguments :: Typed.TypedTerm Checking.TypeArityMismatchError -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Checking.TypeArityMismatchError typeArityMismatchErrorWithTypeArguments original newVal = @@ -461,6 +501,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.TypeMismatchError typeMismatchError :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.TypeMismatchError typeMismatchError expectedType actualType = @@ -473,6 +514,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm actualType)}]})) + -- | DSL accessor for the actualType field of hydra.error.checking.TypeMismatchError typeMismatchErrorActualType :: Typed.TypedTerm Checking.TypeMismatchError -> Typed.TypedTerm Core.Type typeMismatchErrorActualType x = @@ -481,6 +523,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeMismatchError"), Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expectedType field of hydra.error.checking.TypeMismatchError typeMismatchErrorExpectedType :: Typed.TypedTerm Checking.TypeMismatchError -> Typed.TypedTerm Core.Type typeMismatchErrorExpectedType x = @@ -489,6 +532,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeMismatchError"), Core.projectionFieldName = (Core.Name "expectedType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -505,6 +549,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the expectedType field of hydra.error.checking.TypeMismatchError typeMismatchErrorWithExpectedType :: Typed.TypedTerm Checking.TypeMismatchError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.TypeMismatchError typeMismatchErrorWithExpectedType original newVal = @@ -521,6 +566,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.TypeMismatchError"), Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesError :: Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.UnboundTypeVariablesError unboundTypeVariablesError variables type_ = @@ -533,6 +579,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the type field of hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesErrorType :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm Core.Type unboundTypeVariablesErrorType x = @@ -541,6 +588,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnboundTypeVariablesError"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the variables field of hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesErrorVariables :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm (S.Set Core.Name) unboundTypeVariablesErrorVariables x = @@ -549,6 +597,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnboundTypeVariablesError"), Core.projectionFieldName = (Core.Name "variables")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the type field of hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesErrorWithType :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Checking.UnboundTypeVariablesError unboundTypeVariablesErrorWithType original newVal = @@ -565,6 +614,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the variables field of hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesErrorWithVariables :: Typed.TypedTerm Checking.UnboundTypeVariablesError -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Checking.UnboundTypeVariablesError unboundTypeVariablesErrorWithVariables original newVal = @@ -581,6 +631,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnboundTypeVariablesError"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingError path name = @@ -593,6 +644,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the name field of hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorName :: Typed.TypedTerm Checking.UndefinedTermVariableCheckingError -> Typed.TypedTerm Core.Name undefinedTermVariableCheckingErrorName x = @@ -601,6 +653,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UndefinedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the path field of hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorPath :: Typed.TypedTerm Checking.UndefinedTermVariableCheckingError -> Typed.TypedTerm Paths.SubtermPath undefinedTermVariableCheckingErrorPath x = @@ -609,6 +662,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UndefinedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -625,6 +679,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the path field of hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorWithPath :: Typed.TypedTerm Checking.UndefinedTermVariableCheckingError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingErrorWithPath original newVal = @@ -641,6 +696,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UndefinedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.checking.UnequalTypesError unequalTypesError :: Typed.TypedTerm [Core.Type] -> Typed.TypedTerm String -> Typed.TypedTerm Checking.UnequalTypesError unequalTypesError types description = @@ -653,6 +709,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = (Typed.unTypedTerm description)}]})) + -- | DSL accessor for the description field of hydra.error.checking.UnequalTypesError unequalTypesErrorDescription :: Typed.TypedTerm Checking.UnequalTypesError -> Typed.TypedTerm String unequalTypesErrorDescription x = @@ -661,6 +718,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnequalTypesError"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the types field of hydra.error.checking.UnequalTypesError unequalTypesErrorTypes :: Typed.TypedTerm Checking.UnequalTypesError -> Typed.TypedTerm [Core.Type] unequalTypesErrorTypes x = @@ -669,6 +727,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnequalTypesError"), Core.projectionFieldName = (Core.Name "types")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -685,6 +744,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the types field of hydra.error.checking.UnequalTypesError unequalTypesErrorWithTypes :: Typed.TypedTerm Checking.UnequalTypesError -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Checking.UnequalTypesError unequalTypesErrorWithTypes original newVal = @@ -701,6 +761,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnequalTypesError"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.checking.UnsupportedTermVariantError unsupportedTermVariantError :: Typed.TypedTerm Variants.TermVariant -> Typed.TypedTerm Checking.UnsupportedTermVariantError unsupportedTermVariantError termVariant = @@ -710,6 +771,7 @@ Core.Field { Core.fieldName = (Core.Name "termVariant"), Core.fieldTerm = (Typed.unTypedTerm termVariant)}]})) + -- | DSL accessor for the termVariant field of hydra.error.checking.UnsupportedTermVariantError unsupportedTermVariantErrorTermVariant :: Typed.TypedTerm Checking.UnsupportedTermVariantError -> Typed.TypedTerm Variants.TermVariant unsupportedTermVariantErrorTermVariant x = @@ -718,6 +780,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UnsupportedTermVariantError"), Core.projectionFieldName = (Core.Name "termVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -727,12 +790,14 @@ Core.Field { Core.fieldName = (Core.Name "termVariant"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.UntypedLambdaError untypedLambdaError :: Typed.TypedTerm Checking.UntypedLambdaError untypedLambdaError = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.error.checking.UntypedLambdaError"), Core.recordFields = []})) + -- | DSL constructor for hydra.error.checking.UntypedLetBindingError untypedLetBindingError :: Typed.TypedTerm Core.Binding -> Typed.TypedTerm Checking.UntypedLetBindingError untypedLetBindingError binding = @@ -742,6 +807,7 @@ Core.Field { Core.fieldName = (Core.Name "binding"), Core.fieldTerm = (Typed.unTypedTerm binding)}]})) + -- | DSL accessor for the binding field of hydra.error.checking.UntypedLetBindingError untypedLetBindingErrorBinding :: Typed.TypedTerm Checking.UntypedLetBindingError -> Typed.TypedTerm Core.Binding untypedLetBindingErrorBinding x = @@ -750,6 +816,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UntypedLetBindingError"), Core.projectionFieldName = (Core.Name "binding")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -759,6 +826,7 @@ Core.Field { Core.fieldName = (Core.Name "binding"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Checking.UntypedTermVariableCheckingError untypedTermVariableCheckingError path name = @@ -771,6 +839,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the name field of hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorName :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Core.Name untypedTermVariableCheckingErrorName x = @@ -779,6 +848,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UntypedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the path field of hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorPath :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Paths.SubtermPath untypedTermVariableCheckingErrorPath x = @@ -787,6 +857,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.checking.UntypedTermVariableCheckingError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorWithName :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorWithName original newVal = @@ -803,6 +874,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the path field of hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorWithPath :: Typed.TypedTerm Checking.UntypedTermVariableCheckingError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Checking.UntypedTermVariableCheckingError untypedTermVariableCheckingErrorWithPath original newVal = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.error.core module Hydra.Dsl.Error.Core where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths @@ -12,6 +14,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL constructor for hydra.error.core.ConstantConditionError constantConditionError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Bool -> Typed.TypedTerm ErrorCore.ConstantConditionError constantConditionError location value = @@ -24,6 +27,7 @@ Core.Field { Core.fieldName = (Core.Name "value"), Core.fieldTerm = (Typed.unTypedTerm value)}]})) + -- | DSL accessor for the location field of hydra.error.core.ConstantConditionError constantConditionErrorLocation :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm Paths.SubtermPath constantConditionErrorLocation x = @@ -32,6 +36,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.ConstantConditionError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the value field of hydra.error.core.ConstantConditionError constantConditionErrorValue :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm Bool constantConditionErrorValue x = @@ -40,6 +45,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.ConstantConditionError"), Core.projectionFieldName = (Core.Name "value")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.ConstantConditionError constantConditionErrorWithLocation :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.ConstantConditionError constantConditionErrorWithLocation original newVal = @@ -56,6 +62,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.ConstantConditionError"), Core.projectionFieldName = (Core.Name "value")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the value field of hydra.error.core.ConstantConditionError constantConditionErrorWithValue :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm Bool -> Typed.TypedTerm ErrorCore.ConstantConditionError constantConditionErrorWithValue original newVal = @@ -72,6 +79,7 @@ Core.Field { Core.fieldName = (Core.Name "value"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.DuplicateBindingError duplicateBindingError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateBindingError duplicateBindingError location name = @@ -84,6 +92,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.DuplicateBindingError duplicateBindingErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Paths.SubtermPath duplicateBindingErrorLocation x = @@ -92,6 +101,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateBindingError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.DuplicateBindingError duplicateBindingErrorName :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Core.Name duplicateBindingErrorName x = @@ -100,6 +110,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateBindingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.DuplicateBindingError duplicateBindingErrorWithLocation :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.DuplicateBindingError duplicateBindingErrorWithLocation original newVal = @@ -116,6 +127,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateBindingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.DuplicateBindingError duplicateBindingErrorWithName :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateBindingError duplicateBindingErrorWithName original newVal = @@ -132,6 +144,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.DuplicateFieldError duplicateFieldError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateFieldError duplicateFieldError location name = @@ -144,6 +157,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.DuplicateFieldError duplicateFieldErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Paths.SubtermPath duplicateFieldErrorLocation x = @@ -152,6 +166,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateFieldError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.DuplicateFieldError duplicateFieldErrorName :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Core.Name duplicateFieldErrorName x = @@ -160,6 +175,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateFieldError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.DuplicateFieldError duplicateFieldErrorWithLocation :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.DuplicateFieldError duplicateFieldErrorWithLocation original newVal = @@ -176,6 +192,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateFieldError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.DuplicateFieldError duplicateFieldErrorWithName :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateFieldError duplicateFieldErrorWithName original newVal = @@ -192,6 +209,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesError location name = @@ -204,6 +222,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath duplicateRecordTypeFieldNamesErrorLocation x = @@ -212,6 +231,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateRecordTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorName :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm Core.Name duplicateRecordTypeFieldNamesErrorName x = @@ -220,6 +240,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateRecordTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorWithLocation :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorWithLocation original newVal = @@ -236,6 +257,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateRecordTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorWithName :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesErrorWithName original newVal = @@ -252,6 +274,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesError location name = @@ -264,6 +287,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorLocation :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath duplicateUnionTypeFieldNamesErrorLocation x = @@ -272,6 +296,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateUnionTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorName :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm Core.Name duplicateUnionTypeFieldNamesErrorName x = @@ -280,6 +305,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateUnionTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorWithLocation :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorWithLocation original newVal = @@ -296,6 +322,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.DuplicateUnionTypeFieldNamesError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorWithName :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesErrorWithName original newVal = @@ -312,6 +339,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyCaseStatementError emptyCaseStatementError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.EmptyCaseStatementError emptyCaseStatementError location typeName = @@ -324,6 +352,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm typeName)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyCaseStatementError emptyCaseStatementErrorLocation :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm Paths.SubtermPath emptyCaseStatementErrorLocation x = @@ -332,6 +361,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyCaseStatementError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.error.core.EmptyCaseStatementError emptyCaseStatementErrorTypeName :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm Core.Name emptyCaseStatementErrorTypeName x = @@ -340,6 +370,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyCaseStatementError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyCaseStatementError emptyCaseStatementErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyCaseStatementError emptyCaseStatementErrorWithLocation original newVal = @@ -356,6 +387,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyCaseStatementError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeName field of hydra.error.core.EmptyCaseStatementError emptyCaseStatementErrorWithTypeName :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.EmptyCaseStatementError emptyCaseStatementErrorWithTypeName original newVal = @@ -372,6 +404,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyLetBindingsError emptyLetBindingsError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyLetBindingsError emptyLetBindingsError location = @@ -381,6 +414,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyLetBindingsError emptyLetBindingsErrorLocation :: Typed.TypedTerm ErrorCore.EmptyLetBindingsError -> Typed.TypedTerm Paths.SubtermPath emptyLetBindingsErrorLocation x = @@ -389,6 +423,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyLetBindingsError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyLetBindingsError emptyLetBindingsErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyLetBindingsError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyLetBindingsError emptyLetBindingsErrorWithLocation original newVal = @@ -398,6 +433,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyRecordTypeError emptyRecordTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyRecordTypeError emptyRecordTypeError location = @@ -407,6 +443,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyRecordTypeError emptyRecordTypeErrorLocation :: Typed.TypedTerm ErrorCore.EmptyRecordTypeError -> Typed.TypedTerm Paths.SubtermPath emptyRecordTypeErrorLocation x = @@ -415,6 +452,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyRecordTypeError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyRecordTypeError emptyRecordTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyRecordTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyRecordTypeError emptyRecordTypeErrorWithLocation original newVal = @@ -424,6 +462,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTermAnnotationError emptyTermAnnotationError location = @@ -433,6 +472,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTermAnnotationError -> Typed.TypedTerm Paths.SubtermPath emptyTermAnnotationErrorLocation x = @@ -441,6 +481,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyTermAnnotationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyTermAnnotationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTermAnnotationError emptyTermAnnotationErrorWithLocation original newVal = @@ -450,6 +491,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError emptyTypeAnnotationError location = @@ -459,6 +501,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError -> Typed.TypedTerm Paths.SubtermPath emptyTypeAnnotationErrorLocation x = @@ -467,6 +510,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyTypeAnnotationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError emptyTypeAnnotationErrorWithLocation original newVal = @@ -476,6 +520,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError emptyTypeNameInTermError location = @@ -485,6 +530,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermErrorLocation :: Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError -> Typed.TypedTerm Paths.SubtermPath emptyTypeNameInTermErrorLocation x = @@ -493,6 +539,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyTypeNameInTermError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError emptyTypeNameInTermErrorWithLocation original newVal = @@ -502,6 +549,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.EmptyUnionTypeError emptyUnionTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyUnionTypeError emptyUnionTypeError location = @@ -511,6 +559,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.EmptyUnionTypeError emptyUnionTypeErrorLocation :: Typed.TypedTerm ErrorCore.EmptyUnionTypeError -> Typed.TypedTerm Paths.SubtermPath emptyUnionTypeErrorLocation x = @@ -519,6 +568,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.EmptyUnionTypeError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.EmptyUnionTypeError emptyUnionTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.EmptyUnionTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.EmptyUnionTypeError emptyUnionTypeErrorWithLocation original newVal = @@ -528,6 +578,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidForallParameterNameError invalidForallParameterNameError location name = @@ -540,6 +591,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidForallParameterNameErrorLocation x = @@ -548,6 +600,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidForallParameterNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameErrorName :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm Core.Name invalidForallParameterNameErrorName x = @@ -556,6 +609,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidForallParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameErrorWithLocation :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.InvalidForallParameterNameError invalidForallParameterNameErrorWithLocation original newVal = @@ -572,6 +626,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidForallParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameErrorWithName :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidForallParameterNameError invalidForallParameterNameErrorWithName original newVal = @@ -588,6 +643,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError invalidLambdaParameterNameError location name = @@ -600,6 +656,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidLambdaParameterNameErrorLocation x = @@ -608,6 +665,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorName :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm Core.Name invalidLambdaParameterNameErrorName x = @@ -616,6 +674,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorWithLocation :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorWithLocation original newVal = @@ -632,6 +691,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorWithName :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError invalidLambdaParameterNameErrorWithName original newVal = @@ -648,6 +708,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidLetBindingNameError invalidLetBindingNameError location name = @@ -660,6 +721,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm Paths.SubtermPath invalidLetBindingNameErrorLocation x = @@ -668,6 +730,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLetBindingNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameErrorName :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm Core.Name invalidLetBindingNameErrorName x = @@ -676,6 +739,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLetBindingNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameErrorWithLocation :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.InvalidLetBindingNameError invalidLetBindingNameErrorWithLocation original newVal = @@ -692,6 +756,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidLetBindingNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameErrorWithName :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidLetBindingNameError invalidLetBindingNameErrorWithName original newVal = @@ -708,6 +773,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the typeMismatch variant of hydra.error.core.InvalidLiteralError invalidLiteralErrorTypeMismatch :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm ErrorCore.InvalidLiteralError invalidLiteralErrorTypeMismatch x = @@ -716,6 +782,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeMismatch"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the constantCondition variant of hydra.error.core.InvalidTermError invalidTermErrorConstantCondition :: Typed.TypedTerm ErrorCore.ConstantConditionError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorConstantCondition x = @@ -724,6 +791,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "constantCondition"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateBinding variant of hydra.error.core.InvalidTermError invalidTermErrorDuplicateBinding :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorDuplicateBinding x = @@ -732,6 +800,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateField variant of hydra.error.core.InvalidTermError invalidTermErrorDuplicateField :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorDuplicateField x = @@ -740,6 +809,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyCaseStatement variant of hydra.error.core.InvalidTermError invalidTermErrorEmptyCaseStatement :: Typed.TypedTerm ErrorCore.EmptyCaseStatementError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorEmptyCaseStatement x = @@ -748,6 +818,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyCaseStatement"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyLetBindings variant of hydra.error.core.InvalidTermError invalidTermErrorEmptyLetBindings :: Typed.TypedTerm ErrorCore.EmptyLetBindingsError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorEmptyLetBindings x = @@ -756,6 +827,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyLetBindings"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyTermAnnotation variant of hydra.error.core.InvalidTermError invalidTermErrorEmptyTermAnnotation :: Typed.TypedTerm ErrorCore.EmptyTermAnnotationError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorEmptyTermAnnotation x = @@ -764,6 +836,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyTermAnnotation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyTypeNameInTerm variant of hydra.error.core.InvalidTermError invalidTermErrorEmptyTypeNameInTerm :: Typed.TypedTerm ErrorCore.EmptyTypeNameInTermError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorEmptyTypeNameInTerm x = @@ -772,6 +845,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyTypeNameInTerm"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidLambdaParameterName variant of hydra.error.core.InvalidTermError invalidTermErrorInvalidLambdaParameterName :: Typed.TypedTerm ErrorCore.InvalidLambdaParameterNameError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorInvalidLambdaParameterName x = @@ -780,6 +854,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidLambdaParameterName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidLetBindingName variant of hydra.error.core.InvalidTermError invalidTermErrorInvalidLetBindingName :: Typed.TypedTerm ErrorCore.InvalidLetBindingNameError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorInvalidLetBindingName x = @@ -788,6 +863,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidLetBindingName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidTypeLambdaParameterName variant of hydra.error.core.InvalidTermError invalidTermErrorInvalidTypeLambdaParameterName :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorInvalidTypeLambdaParameterName x = @@ -796,6 +872,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidTypeLambdaParameterName"), 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 = @@ -804,6 +881,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedTermAnnotation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the redundantWrapUnwrap variant of hydra.error.core.InvalidTermError invalidTermErrorRedundantWrapUnwrap :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorRedundantWrapUnwrap x = @@ -812,6 +890,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "redundantWrapUnwrap"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the selfApplication variant of hydra.error.core.InvalidTermError invalidTermErrorSelfApplication :: Typed.TypedTerm ErrorCore.SelfApplicationError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorSelfApplication x = @@ -820,6 +899,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "selfApplication"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the termVariableShadowing variant of hydra.error.core.InvalidTermError invalidTermErrorTermVariableShadowing :: Typed.TypedTerm ErrorCore.TermVariableShadowingError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorTermVariableShadowing x = @@ -828,6 +908,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "termVariableShadowing"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeVariableShadowingInTypeLambda variant of hydra.error.core.InvalidTermError invalidTermErrorTypeVariableShadowingInTypeLambda :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorTypeVariableShadowingInTypeLambda x = @@ -836,6 +917,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeVariableShadowingInTypeLambda"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTermVariable variant of hydra.error.core.InvalidTermError invalidTermErrorUndefinedTermVariable :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUndefinedTermVariable x = @@ -844,6 +926,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTypeVariableInBindingType variant of hydra.error.core.InvalidTermError invalidTermErrorUndefinedTypeVariableInBindingType :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUndefinedTypeVariableInBindingType x = @@ -852,6 +935,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTypeVariableInBindingType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTypeVariableInLambdaDomain variant of hydra.error.core.InvalidTermError invalidTermErrorUndefinedTypeVariableInLambdaDomain :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUndefinedTypeVariableInLambdaDomain x = @@ -860,6 +944,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTypeVariableInLambdaDomain"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTypeVariableInTypeApplication variant of hydra.error.core.InvalidTermError invalidTermErrorUndefinedTypeVariableInTypeApplication :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUndefinedTypeVariableInTypeApplication x = @@ -868,6 +953,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTypeVariableInTypeApplication"), 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 = @@ -876,6 +962,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unknownPrimitiveName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unnecessaryIdentityApplication variant of hydra.error.core.InvalidTermError invalidTermErrorUnnecessaryIdentityApplication :: Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUnnecessaryIdentityApplication x = @@ -884,6 +971,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unnecessaryIdentityApplication"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the untypedTermVariable variant of hydra.error.core.InvalidTermError invalidTermErrorUntypedTermVariable :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm ErrorCore.InvalidTermError invalidTermErrorUntypedTermVariable x = @@ -892,6 +980,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateRecordTypeFieldNames variant of hydra.error.core.InvalidTypeError invalidTypeErrorDuplicateRecordTypeFieldNames :: Typed.TypedTerm ErrorCore.DuplicateRecordTypeFieldNamesError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorDuplicateRecordTypeFieldNames x = @@ -900,6 +989,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateRecordTypeFieldNames"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateUnionTypeFieldNames variant of hydra.error.core.InvalidTypeError invalidTypeErrorDuplicateUnionTypeFieldNames :: Typed.TypedTerm ErrorCore.DuplicateUnionTypeFieldNamesError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorDuplicateUnionTypeFieldNames x = @@ -908,6 +998,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateUnionTypeFieldNames"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyRecordType variant of hydra.error.core.InvalidTypeError invalidTypeErrorEmptyRecordType :: Typed.TypedTerm ErrorCore.EmptyRecordTypeError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorEmptyRecordType x = @@ -916,6 +1007,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyRecordType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyTypeAnnotation variant of hydra.error.core.InvalidTypeError invalidTypeErrorEmptyTypeAnnotation :: Typed.TypedTerm ErrorCore.EmptyTypeAnnotationError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorEmptyTypeAnnotation x = @@ -924,6 +1016,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyTypeAnnotation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyUnionType variant of hydra.error.core.InvalidTypeError invalidTypeErrorEmptyUnionType :: Typed.TypedTerm ErrorCore.EmptyUnionTypeError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorEmptyUnionType x = @@ -932,6 +1025,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyUnionType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidForallParameterName variant of hydra.error.core.InvalidTypeError invalidTypeErrorInvalidForallParameterName :: Typed.TypedTerm ErrorCore.InvalidForallParameterNameError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorInvalidForallParameterName x = @@ -940,6 +1034,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidForallParameterName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidTypeSchemeVariableName variant of hydra.error.core.InvalidTypeError invalidTypeErrorInvalidTypeSchemeVariableName :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorInvalidTypeSchemeVariableName x = @@ -948,6 +1043,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidTypeSchemeVariableName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the nestedTypeAnnotation variant of hydra.error.core.InvalidTypeError invalidTypeErrorNestedTypeAnnotation :: Typed.TypedTerm ErrorCore.NestedTypeAnnotationError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorNestedTypeAnnotation x = @@ -956,6 +1052,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedTypeAnnotation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the nonComparableMapKeyType variant of hydra.error.core.InvalidTypeError invalidTypeErrorNonComparableMapKeyType :: Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorNonComparableMapKeyType x = @@ -964,6 +1061,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nonComparableMapKeyType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the nonComparableSetElementType variant of hydra.error.core.InvalidTypeError invalidTypeErrorNonComparableSetElementType :: Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorNonComparableSetElementType x = @@ -972,6 +1070,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nonComparableSetElementType"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the singleVariantUnion variant of hydra.error.core.InvalidTypeError invalidTypeErrorSingleVariantUnion :: Typed.TypedTerm ErrorCore.SingleVariantUnionError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorSingleVariantUnion x = @@ -980,6 +1079,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "singleVariantUnion"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the typeVariableShadowingInForall variant of hydra.error.core.InvalidTypeError invalidTypeErrorTypeVariableShadowingInForall :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorTypeVariableShadowingInForall x = @@ -988,6 +1088,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeVariableShadowingInForall"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTypeVariable variant of hydra.error.core.InvalidTypeError invalidTypeErrorUndefinedTypeVariable :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorUndefinedTypeVariable x = @@ -996,6 +1097,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTypeVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the voidInNonBottomPosition variant of hydra.error.core.InvalidTypeError invalidTypeErrorVoidInNonBottomPosition :: Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError -> Typed.TypedTerm ErrorCore.InvalidTypeError invalidTypeErrorVoidInNonBottomPosition x = @@ -1004,6 +1106,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "voidInNonBottomPosition"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameError location name = @@ -1016,6 +1119,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath invalidTypeLambdaParameterNameErrorLocation x = @@ -1024,6 +1128,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorName :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm Core.Name invalidTypeLambdaParameterNameErrorName x = @@ -1032,6 +1137,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorWithLocation :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorWithLocation original newVal = @@ -1048,6 +1154,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeLambdaParameterNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorWithName :: Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameErrorWithName original newVal = @@ -1064,6 +1171,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameError location name = @@ -1076,6 +1184,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorLocation :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm Paths.SubtermPath invalidTypeSchemeVariableNameErrorLocation x = @@ -1084,6 +1193,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeSchemeVariableNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorName :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm Core.Name invalidTypeSchemeVariableNameErrorName x = @@ -1092,6 +1202,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeSchemeVariableNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorWithLocation :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorWithLocation original newVal = @@ -1108,6 +1219,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.InvalidTypeSchemeVariableNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorWithName :: Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameErrorWithName original newVal = @@ -1124,6 +1236,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.LiteralTypeMismatchError literalTypeMismatchError :: Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm ErrorCore.LiteralTypeMismatchError literalTypeMismatchError expectedType actualType = @@ -1136,6 +1249,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm actualType)}]})) + -- | DSL accessor for the actualType field of hydra.error.core.LiteralTypeMismatchError literalTypeMismatchErrorActualType :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm Core.LiteralType literalTypeMismatchErrorActualType x = @@ -1144,6 +1258,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.LiteralTypeMismatchError"), Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expectedType field of hydra.error.core.LiteralTypeMismatchError literalTypeMismatchErrorExpectedType :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm Core.LiteralType literalTypeMismatchErrorExpectedType x = @@ -1152,6 +1267,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.LiteralTypeMismatchError"), Core.projectionFieldName = (Core.Name "expectedType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1168,6 +1284,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the expectedType field of hydra.error.core.LiteralTypeMismatchError literalTypeMismatchErrorWithExpectedType :: Typed.TypedTerm ErrorCore.LiteralTypeMismatchError -> Typed.TypedTerm Core.LiteralType -> Typed.TypedTerm ErrorCore.LiteralTypeMismatchError literalTypeMismatchErrorWithExpectedType original newVal = @@ -1184,6 +1301,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.LiteralTypeMismatchError"), Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTermAnnotationError nestedTermAnnotationError location = @@ -1193,6 +1311,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.NestedTermAnnotationError nestedTermAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.NestedTermAnnotationError -> Typed.TypedTerm Paths.SubtermPath nestedTermAnnotationErrorLocation x = @@ -1201,6 +1320,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NestedTermAnnotationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1210,6 +1330,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.NestedTypeAnnotationError nestedTypeAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTypeAnnotationError nestedTypeAnnotationError location = @@ -1219,6 +1340,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.NestedTypeAnnotationError nestedTypeAnnotationErrorLocation :: Typed.TypedTerm ErrorCore.NestedTypeAnnotationError -> Typed.TypedTerm Paths.SubtermPath nestedTypeAnnotationErrorLocation x = @@ -1227,6 +1349,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NestedTypeAnnotationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1236,6 +1359,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeError location keyType = @@ -1248,6 +1372,7 @@ Core.Field { Core.fieldName = (Core.Name "keyType"), Core.fieldTerm = (Typed.unTypedTerm keyType)}]})) + -- | DSL accessor for the keyType field of hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorKeyType :: Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError -> Typed.TypedTerm Core.Type nonComparableMapKeyTypeErrorKeyType x = @@ -1256,6 +1381,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableMapKeyTypeError"), Core.projectionFieldName = (Core.Name "keyType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the location field of hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorLocation :: Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError -> Typed.TypedTerm Paths.SubtermPath nonComparableMapKeyTypeErrorLocation x = @@ -1264,6 +1390,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableMapKeyTypeError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1280,6 +1407,7 @@ Core.Field { Core.fieldName = (Core.Name "keyType"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the location field of hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeErrorWithLocation original newVal = @@ -1296,6 +1424,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableMapKeyTypeError"), Core.projectionFieldName = (Core.Name "keyType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError nonComparableSetElementTypeError location elementType = @@ -1308,6 +1437,7 @@ Core.Field { Core.fieldName = (Core.Name "elementType"), Core.fieldTerm = (Typed.unTypedTerm elementType)}]})) + -- | DSL accessor for the elementType field of hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeErrorElementType :: Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError -> Typed.TypedTerm Core.Type nonComparableSetElementTypeErrorElementType x = @@ -1316,6 +1446,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableSetElementTypeError"), Core.projectionFieldName = (Core.Name "elementType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the location field of hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeErrorLocation :: Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError -> Typed.TypedTerm Paths.SubtermPath nonComparableSetElementTypeErrorLocation x = @@ -1324,6 +1455,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableSetElementTypeError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1340,6 +1472,7 @@ Core.Field { Core.fieldName = (Core.Name "elementType"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the location field of hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NonComparableSetElementTypeError nonComparableSetElementTypeErrorWithLocation original newVal = @@ -1356,6 +1489,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.NonComparableSetElementTypeError"), Core.projectionFieldName = (Core.Name "elementType")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError redundantWrapUnwrapError location typeName = @@ -1368,6 +1502,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm typeName)}]})) + -- | DSL accessor for the location field of hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapErrorLocation :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm Paths.SubtermPath redundantWrapUnwrapErrorLocation x = @@ -1376,6 +1511,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.RedundantWrapUnwrapError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapErrorTypeName :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm Core.Name redundantWrapUnwrapErrorTypeName x = @@ -1384,6 +1520,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.RedundantWrapUnwrapError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapErrorWithLocation :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError redundantWrapUnwrapErrorWithLocation original newVal = @@ -1400,6 +1537,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.RedundantWrapUnwrapError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeName field of hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapErrorWithTypeName :: Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.RedundantWrapUnwrapError redundantWrapUnwrapErrorWithTypeName original newVal = @@ -1416,6 +1554,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.SelfApplicationError selfApplicationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.SelfApplicationError selfApplicationError location name = @@ -1428,6 +1567,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.SelfApplicationError selfApplicationErrorLocation :: Typed.TypedTerm ErrorCore.SelfApplicationError -> Typed.TypedTerm Paths.SubtermPath selfApplicationErrorLocation x = @@ -1436,6 +1576,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SelfApplicationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.SelfApplicationError selfApplicationErrorName :: Typed.TypedTerm ErrorCore.SelfApplicationError -> Typed.TypedTerm Core.Name selfApplicationErrorName x = @@ -1444,6 +1585,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SelfApplicationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1460,6 +1602,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SelfApplicationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.SelfApplicationError selfApplicationErrorWithName :: Typed.TypedTerm ErrorCore.SelfApplicationError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.SelfApplicationError selfApplicationErrorWithName original newVal = @@ -1476,6 +1619,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.SingleVariantUnionError singleVariantUnionError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.SingleVariantUnionError singleVariantUnionError location fieldName = @@ -1488,6 +1632,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm fieldName)}]})) + -- | DSL accessor for the fieldName field of hydra.error.core.SingleVariantUnionError singleVariantUnionErrorFieldName :: Typed.TypedTerm ErrorCore.SingleVariantUnionError -> Typed.TypedTerm Core.Name singleVariantUnionErrorFieldName x = @@ -1496,6 +1641,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SingleVariantUnionError"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the location field of hydra.error.core.SingleVariantUnionError singleVariantUnionErrorLocation :: Typed.TypedTerm ErrorCore.SingleVariantUnionError -> Typed.TypedTerm Paths.SubtermPath singleVariantUnionErrorLocation x = @@ -1504,6 +1650,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SingleVariantUnionError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1520,6 +1667,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the location field of hydra.error.core.SingleVariantUnionError singleVariantUnionErrorWithLocation :: Typed.TypedTerm ErrorCore.SingleVariantUnionError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.SingleVariantUnionError singleVariantUnionErrorWithLocation original newVal = @@ -1536,6 +1684,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.SingleVariantUnionError"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.TermVariableShadowingError termVariableShadowingError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TermVariableShadowingError termVariableShadowingError location name = @@ -1548,6 +1697,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.TermVariableShadowingError termVariableShadowingErrorLocation :: Typed.TypedTerm ErrorCore.TermVariableShadowingError -> Typed.TypedTerm Paths.SubtermPath termVariableShadowingErrorLocation x = @@ -1556,6 +1706,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TermVariableShadowingError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.TermVariableShadowingError termVariableShadowingErrorName :: Typed.TypedTerm ErrorCore.TermVariableShadowingError -> Typed.TypedTerm Core.Name termVariableShadowingErrorName x = @@ -1564,6 +1715,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TermVariableShadowingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1580,6 +1732,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TermVariableShadowingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.TermVariableShadowingError termVariableShadowingErrorWithName :: Typed.TypedTerm ErrorCore.TermVariableShadowingError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TermVariableShadowingError termVariableShadowingErrorWithName original newVal = @@ -1596,6 +1749,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError typeVariableShadowingInForallError location name = @@ -1608,6 +1762,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorLocation :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError -> Typed.TypedTerm Paths.SubtermPath typeVariableShadowingInForallErrorLocation x = @@ -1616,6 +1771,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInForallError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorName :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError -> Typed.TypedTerm Core.Name typeVariableShadowingInForallErrorName x = @@ -1624,6 +1780,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInForallError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1640,6 +1797,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInForallError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorWithName :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInForallError typeVariableShadowingInForallErrorWithName original newVal = @@ -1656,6 +1814,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaError location name = @@ -1668,6 +1827,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorLocation :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError -> Typed.TypedTerm Paths.SubtermPath typeVariableShadowingInTypeLambdaErrorLocation x = @@ -1676,6 +1836,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInTypeLambdaError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorName :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError -> Typed.TypedTerm Core.Name typeVariableShadowingInTypeLambdaErrorName x = @@ -1684,6 +1845,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInTypeLambdaError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1700,6 +1862,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.TypeVariableShadowingInTypeLambdaError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorWithName :: Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaErrorWithName original newVal = @@ -1716,6 +1879,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedFieldError undefinedFieldError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedFieldError undefinedFieldError fieldName typeName = @@ -1728,6 +1892,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm typeName)}]})) + -- | DSL accessor for the fieldName field of hydra.error.core.UndefinedFieldError undefinedFieldErrorFieldName :: Typed.TypedTerm ErrorCore.UndefinedFieldError -> Typed.TypedTerm Core.Name undefinedFieldErrorFieldName x = @@ -1736,6 +1901,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedFieldError"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.error.core.UndefinedFieldError undefinedFieldErrorTypeName :: Typed.TypedTerm ErrorCore.UndefinedFieldError -> Typed.TypedTerm Core.Name undefinedFieldErrorTypeName x = @@ -1744,6 +1910,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedFieldError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1760,6 +1927,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedFieldError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeName field of hydra.error.core.UndefinedFieldError undefinedFieldErrorWithTypeName :: Typed.TypedTerm ErrorCore.UndefinedFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedFieldError undefinedFieldErrorWithTypeName original newVal = @@ -1776,6 +1944,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedTermVariableError undefinedTermVariableError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTermVariableError undefinedTermVariableError location name = @@ -1788,6 +1957,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UndefinedTermVariableError undefinedTermVariableErrorLocation :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm Paths.SubtermPath undefinedTermVariableErrorLocation x = @@ -1796,6 +1966,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTermVariableError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UndefinedTermVariableError undefinedTermVariableErrorName :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm Core.Name undefinedTermVariableErrorName x = @@ -1804,6 +1975,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTermVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1820,6 +1992,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTermVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UndefinedTermVariableError undefinedTermVariableErrorWithName :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTermVariableError undefinedTermVariableErrorWithName original newVal = @@ -1836,6 +2009,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableError undefinedTypeVariableError location name = @@ -1848,6 +2022,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableErrorLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableError -> Typed.TypedTerm Paths.SubtermPath undefinedTypeVariableErrorLocation x = @@ -1856,6 +2031,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableErrorName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableError -> Typed.TypedTerm Core.Name undefinedTypeVariableErrorName x = @@ -1864,6 +2040,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1880,6 +2057,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableErrorWithName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableError undefinedTypeVariableErrorWithName original newVal = @@ -1896,6 +2074,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeError location name = @@ -1908,6 +2087,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError -> Typed.TypedTerm Paths.SubtermPath undefinedTypeVariableInBindingTypeErrorLocation x = @@ -1916,6 +2096,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInBindingTypeError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError -> Typed.TypedTerm Core.Name undefinedTypeVariableInBindingTypeErrorName x = @@ -1924,6 +2105,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInBindingTypeError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1940,6 +2122,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInBindingTypeError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorWithName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeErrorWithName original newVal = @@ -1956,6 +2139,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainError location name = @@ -1968,6 +2152,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Typed.TypedTerm Paths.SubtermPath undefinedTypeVariableInLambdaDomainErrorLocation x = @@ -1976,6 +2161,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInLambdaDomainError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Typed.TypedTerm Core.Name undefinedTypeVariableInLambdaDomainErrorName x = @@ -1984,6 +2170,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInLambdaDomainError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2000,6 +2187,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInLambdaDomainError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorWithName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainErrorWithName original newVal = @@ -2016,6 +2204,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationError location name = @@ -2028,6 +2217,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorLocation :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Typed.TypedTerm Paths.SubtermPath undefinedTypeVariableInTypeApplicationErrorLocation x = @@ -2036,6 +2226,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInTypeApplicationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Typed.TypedTerm Core.Name undefinedTypeVariableInTypeApplicationErrorName x = @@ -2044,6 +2235,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInTypeApplicationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2060,6 +2252,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UndefinedTypeVariableInTypeApplicationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorWithName :: Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationErrorWithName original newVal = @@ -2076,6 +2269,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantError :: Typed.TypedTerm Variants.TermVariant -> Typed.TypedTerm Core.Term -> Typed.TypedTerm ErrorCore.UnexpectedTermVariantError unexpectedTermVariantError expectedVariant actualTerm = @@ -2088,6 +2282,7 @@ Core.Field { Core.fieldName = (Core.Name "actualTerm"), Core.fieldTerm = (Typed.unTypedTerm actualTerm)}]})) + -- | DSL accessor for the actualTerm field of hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantErrorActualTerm :: Typed.TypedTerm ErrorCore.UnexpectedTermVariantError -> Typed.TypedTerm Core.Term unexpectedTermVariantErrorActualTerm x = @@ -2096,6 +2291,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTermVariantError"), Core.projectionFieldName = (Core.Name "actualTerm")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expectedVariant field of hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantErrorExpectedVariant :: Typed.TypedTerm ErrorCore.UnexpectedTermVariantError -> Typed.TypedTerm Variants.TermVariant unexpectedTermVariantErrorExpectedVariant x = @@ -2104,6 +2300,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTermVariantError"), Core.projectionFieldName = (Core.Name "expectedVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2120,6 +2317,7 @@ Core.Field { Core.fieldName = (Core.Name "actualTerm"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the expectedVariant field of hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantErrorWithExpectedVariant :: Typed.TypedTerm ErrorCore.UnexpectedTermVariantError -> Typed.TypedTerm Variants.TermVariant -> Typed.TypedTerm ErrorCore.UnexpectedTermVariantError unexpectedTermVariantErrorWithExpectedVariant original newVal = @@ -2136,6 +2334,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTermVariantError"), Core.projectionFieldName = (Core.Name "actualTerm")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantError :: Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError unexpectedTypeVariantError expectedVariant actualType = @@ -2148,6 +2347,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm actualType)}]})) + -- | DSL accessor for the actualType field of hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantErrorActualType :: Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError -> Typed.TypedTerm Core.Type unexpectedTypeVariantErrorActualType x = @@ -2156,6 +2356,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTypeVariantError"), Core.projectionFieldName = (Core.Name "actualType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expectedVariant field of hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantErrorExpectedVariant :: Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError -> Typed.TypedTerm Variants.TypeVariant unexpectedTypeVariantErrorExpectedVariant x = @@ -2164,6 +2365,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTypeVariantError"), Core.projectionFieldName = (Core.Name "expectedVariant")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2180,6 +2382,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the expectedVariant field of hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantErrorWithExpectedVariant :: Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError -> Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError unexpectedTypeVariantErrorWithExpectedVariant original newVal = @@ -2196,6 +2399,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnexpectedTypeVariantError"), Core.projectionFieldName = (Core.Name "actualType")})), 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 = @@ -2208,6 +2412,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameErrorLocation :: Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError -> Typed.TypedTerm Paths.SubtermPath unknownPrimitiveNameErrorLocation x = @@ -2216,6 +2421,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownPrimitiveNameError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameErrorName :: Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError -> Typed.TypedTerm Core.Name unknownPrimitiveNameErrorName x = @@ -2224,6 +2430,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownPrimitiveNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2240,6 +2447,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownPrimitiveNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameErrorWithName :: Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownPrimitiveNameError unknownPrimitiveNameErrorWithName original newVal = @@ -2256,6 +2464,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError location = @@ -2265,6 +2474,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationErrorLocation :: Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError -> Typed.TypedTerm Paths.SubtermPath unnecessaryIdentityApplicationErrorLocation x = @@ -2273,6 +2483,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UnnecessaryIdentityApplicationError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2282,6 +2493,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.UntypedTermVariableError untypedTermVariableError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UntypedTermVariableError untypedTermVariableError location name = @@ -2294,6 +2506,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the location field of hydra.error.core.UntypedTermVariableError untypedTermVariableErrorLocation :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm Paths.SubtermPath untypedTermVariableErrorLocation x = @@ -2302,6 +2515,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UntypedTermVariableError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.core.UntypedTermVariableError untypedTermVariableErrorName :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm Core.Name untypedTermVariableErrorName x = @@ -2310,6 +2524,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UntypedTermVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -2326,6 +2541,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.UntypedTermVariableError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.core.UntypedTermVariableError untypedTermVariableErrorWithName :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UntypedTermVariableError untypedTermVariableErrorWithName original newVal = @@ -2342,6 +2558,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError voidInNonBottomPositionError location = @@ -2351,6 +2568,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm location)}]})) + -- | DSL accessor for the location field of hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionErrorLocation :: Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError -> Typed.TypedTerm Paths.SubtermPath voidInNonBottomPositionErrorLocation x = @@ -2359,6 +2577,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.core.VoidInNonBottomPositionError"), Core.projectionFieldName = (Core.Name "location")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the location field of hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionErrorWithLocation :: Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.VoidInNonBottomPositionError voidInNonBottomPositionErrorWithLocation original newVal = diff --git a/src/main/haskell/Hydra/Dsl/Error/File.hs b/src/main/haskell/Hydra/Dsl/Error/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Error/File.hs @@ -0,0 +1,58 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.error.file + +module Hydra.Dsl.Error.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Error.File as ErrorFile +import qualified Hydra.File as File +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 alreadyExists variant of hydra.error.file.FileError +fileErrorAlreadyExists :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm ErrorFile.FileError +fileErrorAlreadyExists x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "alreadyExists"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the invalidPath variant of hydra.error.file.FileError +fileErrorInvalidPath :: Typed.TypedTerm String -> Typed.TypedTerm ErrorFile.FileError +fileErrorInvalidPath x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "invalidPath"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the notFound variant of hydra.error.file.FileError +fileErrorNotFound :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm ErrorFile.FileError +fileErrorNotFound x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "notFound"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the other variant of hydra.error.file.FileError +fileErrorOther :: Typed.TypedTerm String -> Typed.TypedTerm ErrorFile.FileError +fileErrorOther x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "other"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the permissionDenied variant of hydra.error.file.FileError +fileErrorPermissionDenied :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm ErrorFile.FileError +fileErrorPermissionDenied x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "permissionDenied"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.error.packaging module Hydra.Dsl.Error.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Packaging as DslPackaging @@ -12,6 +14,7 @@ import qualified Hydra.Util as Util import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL constructor for hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError conflictingModuleNameError first second = @@ -24,6 +27,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (Typed.unTypedTerm second)}]})) + -- | DSL accessor for the first field of hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameErrorFirst :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm Packaging.ModuleName conflictingModuleNameErrorFirst x = @@ -32,6 +36,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingModuleNameError"), Core.projectionFieldName = (Core.Name "first")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the second field of hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameErrorSecond :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm Packaging.ModuleName conflictingModuleNameErrorSecond x = @@ -40,6 +45,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingModuleNameError"), Core.projectionFieldName = (Core.Name "second")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the first field of hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameErrorWithFirst :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError conflictingModuleNameErrorWithFirst original newVal = @@ -56,6 +62,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingModuleNameError"), Core.projectionFieldName = (Core.Name "second")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the second field of hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameErrorWithSecond :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError conflictingModuleNameErrorWithSecond original newVal = @@ -72,6 +79,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError conflictingVariantNameError moduleName typeName variantName conflictingName = @@ -90,6 +98,7 @@ Core.Field { Core.fieldName = (Core.Name "conflictingName"), Core.fieldTerm = (Typed.unTypedTerm conflictingName)}]})) + -- | DSL accessor for the conflictingName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorConflictingName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name conflictingVariantNameErrorConflictingName x = @@ -98,6 +107,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "conflictingName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Packaging.ModuleName conflictingVariantNameErrorModuleName x = @@ -106,6 +116,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorTypeName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name conflictingVariantNameErrorTypeName x = @@ -114,6 +125,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "typeName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the variantName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorVariantName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name conflictingVariantNameErrorVariantName x = @@ -122,6 +134,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "variantName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the conflictingName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorWithConflictingName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError conflictingVariantNameErrorWithConflictingName original newVal = @@ -152,6 +165,7 @@ Core.Field { Core.fieldName = (Core.Name "conflictingName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the moduleName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError conflictingVariantNameErrorWithModuleName original newVal = @@ -182,6 +196,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "conflictingName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorWithTypeName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError conflictingVariantNameErrorWithTypeName original newVal = @@ -212,6 +227,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "conflictingName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the variantName field of hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameErrorWithVariantName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError conflictingVariantNameErrorWithVariantName original newVal = @@ -242,6 +258,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.ConflictingVariantNameError"), Core.projectionFieldName = (Core.Name "conflictingName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError definitionNotInModuleNameError moduleName name = @@ -254,6 +271,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm Packaging.ModuleName definitionNotInModuleNameErrorModuleName x = @@ -262,6 +280,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionNotInModuleNameError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm Core.Name definitionNotInModuleNameErrorName x = @@ -270,6 +289,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionNotInModuleNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the moduleName field of hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorWithModuleName original newVal = @@ -286,6 +306,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionNotInModuleNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorWithName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError definitionNotInModuleNameErrorWithName original newVal = @@ -302,6 +323,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError definitionsOutOfOrderError moduleName precedingName followingName = @@ -317,6 +339,7 @@ Core.Field { Core.fieldName = (Core.Name "followingName"), Core.fieldTerm = (Typed.unTypedTerm followingName)}]})) + -- | DSL accessor for the followingName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorFollowingName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Core.Name definitionsOutOfOrderErrorFollowingName x = @@ -325,6 +348,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError"), Core.projectionFieldName = (Core.Name "followingName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Packaging.ModuleName definitionsOutOfOrderErrorModuleName x = @@ -333,6 +357,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the precedingName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorPrecedingName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Core.Name definitionsOutOfOrderErrorPrecedingName x = @@ -341,6 +366,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError"), Core.projectionFieldName = (Core.Name "precedingName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the followingName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithFollowingName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithFollowingName original newVal = @@ -364,6 +390,7 @@ Core.Field { Core.fieldName = (Core.Name "followingName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the moduleName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithModuleName original newVal = @@ -387,6 +414,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError"), Core.projectionFieldName = (Core.Name "followingName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the precedingName field of hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithPrecedingName :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError definitionsOutOfOrderErrorWithPrecedingName original newVal = @@ -410,6 +438,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError"), Core.projectionFieldName = (Core.Name "followingName")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError duplicateDefinitionNameError moduleName name = @@ -422,6 +451,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName duplicateDefinitionNameErrorModuleName x = @@ -430,6 +460,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DuplicateDefinitionNameError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm Core.Name duplicateDefinitionNameErrorName x = @@ -438,6 +469,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DuplicateDefinitionNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the moduleName field of hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorWithModuleName original newVal = @@ -454,6 +486,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DuplicateDefinitionNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorWithName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError duplicateDefinitionNameErrorWithName original newVal = @@ -470,6 +503,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError duplicateModuleNameError moduleName = @@ -479,6 +513,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm moduleName)}]})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError -> Typed.TypedTerm Packaging.ModuleName duplicateModuleNameErrorModuleName x = @@ -487,6 +522,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.DuplicateModuleNameError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the moduleName field of hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError duplicateModuleNameErrorWithModuleName original newVal = @@ -496,6 +532,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError invalidDefinitionNameError moduleName name expectedConvention = @@ -511,6 +548,7 @@ Core.Field { Core.fieldName = (Core.Name "expectedConvention"), Core.fieldTerm = (Typed.unTypedTerm expectedConvention)}]})) + -- | DSL accessor for the expectedConvention field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorExpectedConvention :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Util.CaseConvention invalidDefinitionNameErrorExpectedConvention x = @@ -519,6 +557,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidDefinitionNameError"), Core.projectionFieldName = (Core.Name "expectedConvention")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorModuleName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName invalidDefinitionNameErrorModuleName x = @@ -527,6 +566,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidDefinitionNameError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Core.Name invalidDefinitionNameErrorName x = @@ -535,6 +575,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidDefinitionNameError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the expectedConvention field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithExpectedConvention :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Util.CaseConvention -> Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithExpectedConvention original newVal = @@ -558,6 +599,7 @@ Core.Field { Core.fieldName = (Core.Name "expectedConvention"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the moduleName field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithModuleName original newVal = @@ -581,6 +623,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidDefinitionNameError"), Core.projectionFieldName = (Core.Name "expectedConvention")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError invalidDefinitionNameErrorWithName original newVal = @@ -604,6 +647,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidDefinitionNameError"), Core.projectionFieldName = (Core.Name "expectedConvention")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the conflictingVariantName variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorConflictingVariantName :: Typed.TypedTerm ErrorPackaging.ConflictingVariantNameError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorConflictingVariantName x = @@ -612,6 +656,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "conflictingVariantName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the definitionNotInModuleName variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorDefinitionNotInModuleName :: Typed.TypedTerm ErrorPackaging.DefinitionNotInModuleNameError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorDefinitionNotInModuleName x = @@ -620,6 +665,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "definitionNotInModuleName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the definitionsOutOfOrder variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorDefinitionsOutOfOrder :: Typed.TypedTerm ErrorPackaging.DefinitionsOutOfOrderError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorDefinitionsOutOfOrder x = @@ -628,6 +674,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "definitionsOutOfOrder"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateDefinitionName variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorDuplicateDefinitionName :: Typed.TypedTerm ErrorPackaging.DuplicateDefinitionNameError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorDuplicateDefinitionName x = @@ -636,6 +683,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateDefinitionName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidDefinitionName variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorInvalidDefinitionName :: Typed.TypedTerm ErrorPackaging.InvalidDefinitionNameError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorInvalidDefinitionName x = @@ -644,6 +692,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidDefinitionName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidModuleNameConvention variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorInvalidModuleNameConvention :: Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorInvalidModuleNameConvention x = @@ -652,6 +701,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidModuleNameConvention"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the missingDocumentation variant of hydra.error.packaging.InvalidModuleError invalidModuleErrorMissingDocumentation :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm ErrorPackaging.InvalidModuleError invalidModuleErrorMissingDocumentation x = @@ -660,6 +710,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "missingDocumentation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError invalidModuleNameConventionError moduleName = @@ -669,6 +720,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm moduleName)}]})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionErrorModuleName :: Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError -> Typed.TypedTerm Packaging.ModuleName invalidModuleNameConventionErrorModuleName x = @@ -677,6 +729,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidModuleNameConventionError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the moduleName field of hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.InvalidModuleNameConventionError invalidModuleNameConventionErrorWithModuleName original newVal = @@ -686,6 +739,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the conflictingModuleName variant of hydra.error.packaging.InvalidPackageError invalidPackageErrorConflictingModuleName :: Typed.TypedTerm ErrorPackaging.ConflictingModuleNameError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError invalidPackageErrorConflictingModuleName x = @@ -694,6 +748,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "conflictingModuleName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateModuleName variant of hydra.error.packaging.InvalidPackageError invalidPackageErrorDuplicateModuleName :: Typed.TypedTerm ErrorPackaging.DuplicateModuleNameError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError invalidPackageErrorDuplicateModuleName x = @@ -702,6 +757,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateModuleName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidModule variant of hydra.error.packaging.InvalidPackageError invalidPackageErrorInvalidModule :: Typed.TypedTerm ErrorPackaging.InvalidModuleError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError invalidPackageErrorInvalidModule x = @@ -710,6 +766,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidModule"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidPackageName variant of hydra.error.packaging.InvalidPackageError invalidPackageErrorInvalidPackageName :: Typed.TypedTerm ErrorPackaging.InvalidPackageNameError -> Typed.TypedTerm ErrorPackaging.InvalidPackageError invalidPackageErrorInvalidPackageName x = @@ -718,6 +775,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidPackageName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.error.packaging.InvalidPackageNameError invalidPackageNameError :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm ErrorPackaging.InvalidPackageNameError invalidPackageNameError packageName = @@ -727,6 +785,7 @@ Core.Field { Core.fieldName = (Core.Name "packageName"), Core.fieldTerm = (Typed.unTypedTerm packageName)}]})) + -- | DSL accessor for the packageName field of hydra.error.packaging.InvalidPackageNameError invalidPackageNameErrorPackageName :: Typed.TypedTerm ErrorPackaging.InvalidPackageNameError -> Typed.TypedTerm Packaging.PackageName invalidPackageNameErrorPackageName x = @@ -735,6 +794,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.InvalidPackageNameError"), Core.projectionFieldName = (Core.Name "packageName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the packageName field of hydra.error.packaging.InvalidPackageNameError invalidPackageNameErrorWithPackageName :: Typed.TypedTerm ErrorPackaging.InvalidPackageNameError -> Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm ErrorPackaging.InvalidPackageNameError invalidPackageNameErrorWithPackageName original newVal = @@ -744,6 +804,7 @@ Core.Field { Core.fieldName = (Core.Name "packageName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.error.packaging.MissingDocumentationError missingDocumentationError :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.MissingDocumentationError missingDocumentationError moduleName name = @@ -756,6 +817,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the moduleName field of hydra.error.packaging.MissingDocumentationError missingDocumentationErrorModuleName :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm Packaging.ModuleName missingDocumentationErrorModuleName x = @@ -764,6 +826,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.MissingDocumentationError"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.error.packaging.MissingDocumentationError missingDocumentationErrorName :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm Core.Name missingDocumentationErrorName x = @@ -772,6 +835,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.MissingDocumentationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the moduleName field of hydra.error.packaging.MissingDocumentationError missingDocumentationErrorWithModuleName :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm ErrorPackaging.MissingDocumentationError missingDocumentationErrorWithModuleName original newVal = @@ -788,6 +852,7 @@ Core.projectionTypeName = (Core.Name "hydra.error.packaging.MissingDocumentationError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.error.packaging.MissingDocumentationError missingDocumentationErrorWithName :: Typed.TypedTerm ErrorPackaging.MissingDocumentationError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorPackaging.MissingDocumentationError missingDocumentationErrorWithName original newVal = diff --git a/src/main/haskell/Hydra/Dsl/Error/System.hs b/src/main/haskell/Hydra/Dsl/Error/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Error/System.hs @@ -0,0 +1,58 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.error.system + +module Hydra.Dsl.Error.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.Error.System as System +import qualified Hydra.File as File +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 commandNotFound variant of hydra.error.system.SystemError +systemErrorCommandNotFound :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm System.SystemError +systemErrorCommandNotFound x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "commandNotFound"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the interrupted variant of hydra.error.system.SystemError +systemErrorInterrupted :: Typed.TypedTerm System.SystemError +systemErrorInterrupted = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "interrupted"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the invalidWorkingDirectory variant of hydra.error.system.SystemError +systemErrorInvalidWorkingDirectory :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm System.SystemError +systemErrorInvalidWorkingDirectory x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "invalidWorkingDirectory"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the other variant of hydra.error.system.SystemError +systemErrorOther :: Typed.TypedTerm String -> Typed.TypedTerm System.SystemError +systemErrorOther x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "other"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the permissionDenied variant of hydra.error.system.SystemError +systemErrorPermissionDenied :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm System.SystemError +systemErrorPermissionDenied x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "permissionDenied"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.errors module Hydra.Dsl.Errors where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Error.Checking as ErrorChecking @@ -18,12 +20,14 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL constructor for the hydra.errors.DecodingError wrapper decodingError :: Typed.TypedTerm String -> Typed.TypedTerm Errors.DecodingError decodingError x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL injection for the checking variant of hydra.errors.Error errorChecking :: Typed.TypedTerm Checking.CheckingError -> Typed.TypedTerm Errors.Error errorChecking x = @@ -32,6 +36,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "checking"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the decoding variant of hydra.errors.Error errorDecoding :: Typed.TypedTerm Errors.DecodingError -> Typed.TypedTerm Errors.Error errorDecoding x = @@ -40,6 +45,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decoding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateBinding variant of hydra.errors.Error errorDuplicateBinding :: Typed.TypedTerm ErrorCore.DuplicateBindingError -> Typed.TypedTerm Errors.Error errorDuplicateBinding x = @@ -48,6 +54,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the duplicateField variant of hydra.errors.Error errorDuplicateField :: Typed.TypedTerm ErrorCore.DuplicateFieldError -> Typed.TypedTerm Errors.Error errorDuplicateField x = @@ -56,6 +63,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "duplicateField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the extraction variant of hydra.errors.Error errorExtraction :: Typed.TypedTerm Errors.ExtractionError -> Typed.TypedTerm Errors.Error errorExtraction x = @@ -64,6 +72,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "extraction"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the inference variant of hydra.errors.Error errorInference :: Typed.TypedTerm Errors.InferenceError -> Typed.TypedTerm Errors.Error errorInference x = @@ -72,6 +81,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "inference"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the invalidLiteral variant of hydra.errors.Error errorInvalidLiteral :: Typed.TypedTerm ErrorCore.InvalidLiteralError -> Typed.TypedTerm Errors.Error errorInvalidLiteral x = @@ -80,6 +90,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidLiteral"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the other variant of hydra.errors.Error errorOther :: Typed.TypedTerm Errors.OtherError -> Typed.TypedTerm Errors.Error errorOther x = @@ -88,6 +99,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "other"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the resolution variant of hydra.errors.Error errorResolution :: Typed.TypedTerm Errors.ResolutionError -> Typed.TypedTerm Errors.Error errorResolution x = @@ -96,6 +108,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "resolution"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedField variant of hydra.errors.Error errorUndefinedField :: Typed.TypedTerm ErrorCore.UndefinedFieldError -> Typed.TypedTerm Errors.Error errorUndefinedField x = @@ -104,6 +117,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the undefinedTermVariable variant of hydra.errors.Error errorUndefinedTermVariable :: Typed.TypedTerm ErrorCore.UndefinedTermVariableError -> Typed.TypedTerm Errors.Error errorUndefinedTermVariable x = @@ -112,6 +126,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "undefinedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unexpectedTermVariant variant of hydra.errors.Error errorUnexpectedTermVariant :: Typed.TypedTerm ErrorCore.UnexpectedTermVariantError -> Typed.TypedTerm Errors.Error errorUnexpectedTermVariant x = @@ -120,6 +135,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedTermVariant"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unexpectedTypeVariant variant of hydra.errors.Error errorUnexpectedTypeVariant :: Typed.TypedTerm ErrorCore.UnexpectedTypeVariantError -> Typed.TypedTerm Errors.Error errorUnexpectedTypeVariant x = @@ -128,6 +144,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedTypeVariant"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unification variant of hydra.errors.Error errorUnification :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Errors.Error errorUnification x = @@ -136,6 +153,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unification"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the untypedTermVariable variant of hydra.errors.Error errorUntypedTermVariable :: Typed.TypedTerm ErrorCore.UntypedTermVariableError -> Typed.TypedTerm Errors.Error errorUntypedTermVariable x = @@ -144,6 +162,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedTermVariable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the emptyList variant of hydra.errors.ExtractionError extractionErrorEmptyList :: Typed.TypedTerm Errors.EmptyListError -> Typed.TypedTerm Errors.ExtractionError extractionErrorEmptyList x = @@ -152,6 +171,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyList"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the multipleBindings variant of hydra.errors.ExtractionError extractionErrorMultipleBindings :: Typed.TypedTerm Errors.MultipleBindingsError -> Typed.TypedTerm Errors.ExtractionError extractionErrorMultipleBindings x = @@ -160,6 +180,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "multipleBindings"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the multipleFields variant of hydra.errors.ExtractionError extractionErrorMultipleFields :: Typed.TypedTerm Errors.MultipleFieldsError -> Typed.TypedTerm Errors.ExtractionError extractionErrorMultipleFields x = @@ -168,6 +189,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "multipleFields"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the noMatchingField variant of hydra.errors.ExtractionError extractionErrorNoMatchingField :: Typed.TypedTerm Errors.NoMatchingFieldError -> Typed.TypedTerm Errors.ExtractionError extractionErrorNoMatchingField x = @@ -176,6 +198,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "noMatchingField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the noSuchBinding variant of hydra.errors.ExtractionError extractionErrorNoSuchBinding :: Typed.TypedTerm Errors.NoSuchBindingError -> Typed.TypedTerm Errors.ExtractionError extractionErrorNoSuchBinding x = @@ -184,6 +207,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "noSuchBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the notEnoughCases variant of hydra.errors.ExtractionError extractionErrorNotEnoughCases :: Typed.TypedTerm Errors.NotEnoughCasesError -> Typed.TypedTerm Errors.ExtractionError extractionErrorNotEnoughCases x = @@ -192,6 +216,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "notEnoughCases"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unexpectedShape variant of hydra.errors.ExtractionError extractionErrorUnexpectedShape :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm Errors.ExtractionError extractionErrorUnexpectedShape x = @@ -200,6 +225,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedShape"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the checking variant of hydra.errors.InferenceError inferenceErrorChecking :: Typed.TypedTerm Checking.CheckingError -> Typed.TypedTerm Errors.InferenceError inferenceErrorChecking x = @@ -208,6 +234,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "checking"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the other variant of hydra.errors.InferenceError inferenceErrorOther :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm Errors.InferenceError inferenceErrorOther x = @@ -216,6 +243,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "other"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unification variant of hydra.errors.InferenceError inferenceErrorUnification :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Errors.InferenceError inferenceErrorUnification x = @@ -224,6 +252,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unification"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.errors.MultipleBindingsError multipleBindingsError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.MultipleBindingsError multipleBindingsError name = @@ -233,6 +262,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the name field of hydra.errors.MultipleBindingsError multipleBindingsErrorName :: Typed.TypedTerm Errors.MultipleBindingsError -> Typed.TypedTerm Core.Name multipleBindingsErrorName x = @@ -241,6 +271,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.MultipleBindingsError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.errors.MultipleBindingsError multipleBindingsErrorWithName :: Typed.TypedTerm Errors.MultipleBindingsError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.MultipleBindingsError multipleBindingsErrorWithName original newVal = @@ -250,6 +281,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.errors.MultipleFieldsError multipleFieldsError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.MultipleFieldsError multipleFieldsError fieldName = @@ -259,6 +291,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm fieldName)}]})) + -- | DSL accessor for the fieldName field of hydra.errors.MultipleFieldsError multipleFieldsErrorFieldName :: Typed.TypedTerm Errors.MultipleFieldsError -> Typed.TypedTerm Core.Name multipleFieldsErrorFieldName x = @@ -267,6 +300,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.MultipleFieldsError"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -276,6 +310,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.errors.NoMatchingFieldError noMatchingFieldError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoMatchingFieldError noMatchingFieldError fieldName = @@ -285,6 +320,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm fieldName)}]})) + -- | DSL accessor for the fieldName field of hydra.errors.NoMatchingFieldError noMatchingFieldErrorFieldName :: Typed.TypedTerm Errors.NoMatchingFieldError -> Typed.TypedTerm Core.Name noMatchingFieldErrorFieldName x = @@ -293,6 +329,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.NoMatchingFieldError"), Core.projectionFieldName = (Core.Name "fieldName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -302,6 +339,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.errors.NoSuchBindingError noSuchBindingError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoSuchBindingError noSuchBindingError name = @@ -311,6 +349,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the name field of hydra.errors.NoSuchBindingError noSuchBindingErrorName :: Typed.TypedTerm Errors.NoSuchBindingError -> Typed.TypedTerm Core.Name noSuchBindingErrorName x = @@ -319,6 +358,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.NoSuchBindingError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -328,6 +368,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.errors.NoSuchPrimitiveError noSuchPrimitiveError :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Errors.NoSuchPrimitiveError noSuchPrimitiveError name = @@ -337,6 +378,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm name)}]})) + -- | DSL accessor for the name field of hydra.errors.NoSuchPrimitiveError noSuchPrimitiveErrorName :: Typed.TypedTerm Errors.NoSuchPrimitiveError -> Typed.TypedTerm Core.Name noSuchPrimitiveErrorName x = @@ -345,6 +387,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.NoSuchPrimitiveError"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -354,12 +397,14 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.errors.OtherError wrapper otherError :: Typed.TypedTerm String -> Typed.TypedTerm Errors.OtherError otherError x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.errors.OtherInferenceError otherInferenceError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm String -> Typed.TypedTerm Errors.OtherInferenceError otherInferenceError path message = @@ -372,6 +417,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm message)}]})) + -- | DSL accessor for the message field of hydra.errors.OtherInferenceError otherInferenceErrorMessage :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm String otherInferenceErrorMessage x = @@ -380,6 +426,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.OtherInferenceError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the path field of hydra.errors.OtherInferenceError otherInferenceErrorPath :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm Paths.SubtermPath otherInferenceErrorPath x = @@ -388,6 +435,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.OtherInferenceError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the message field of hydra.errors.OtherInferenceError otherInferenceErrorWithMessage :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm String -> Typed.TypedTerm Errors.OtherInferenceError otherInferenceErrorWithMessage original newVal = @@ -404,6 +452,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the path field of hydra.errors.OtherInferenceError otherInferenceErrorWithPath :: Typed.TypedTerm Errors.OtherInferenceError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Errors.OtherInferenceError otherInferenceErrorWithPath original newVal = @@ -420,12 +469,14 @@ Core.projectionTypeName = (Core.Name "hydra.errors.OtherInferenceError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.errors.OtherResolutionError wrapper otherResolutionError :: Typed.TypedTerm String -> Typed.TypedTerm Errors.OtherResolutionError otherResolutionError x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherResolutionError"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL injection for the noMatchingField variant of hydra.errors.ResolutionError resolutionErrorNoMatchingField :: Typed.TypedTerm Errors.NoMatchingFieldError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorNoMatchingField x = @@ -434,6 +485,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "noMatchingField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the noSuchBinding variant of hydra.errors.ResolutionError resolutionErrorNoSuchBinding :: Typed.TypedTerm Errors.NoSuchBindingError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorNoSuchBinding x = @@ -442,6 +494,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "noSuchBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the noSuchPrimitive variant of hydra.errors.ResolutionError resolutionErrorNoSuchPrimitive :: Typed.TypedTerm Errors.NoSuchPrimitiveError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorNoSuchPrimitive x = @@ -450,6 +503,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "noSuchPrimitive"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the other variant of hydra.errors.ResolutionError resolutionErrorOther :: Typed.TypedTerm Errors.OtherResolutionError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorOther x = @@ -458,6 +512,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "other"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unexpectedShape variant of hydra.errors.ResolutionError resolutionErrorUnexpectedShape :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm Errors.ResolutionError resolutionErrorUnexpectedShape x = @@ -466,24 +521,28 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedShape"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL accessor for the body of hydra.errors.DecodingError unDecodingError :: Typed.TypedTerm Errors.DecodingError -> Typed.TypedTerm String unDecodingError x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.errors.DecodingError")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.errors.OtherError unOtherError :: Typed.TypedTerm Errors.OtherError -> Typed.TypedTerm String unOtherError x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.errors.OtherError")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.errors.OtherResolutionError unOtherResolutionError :: Typed.TypedTerm Errors.OtherResolutionError -> Typed.TypedTerm String unOtherResolutionError x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.errors.OtherResolutionError")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.errors.UnexpectedShapeError unexpectedShapeError :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Errors.UnexpectedShapeError unexpectedShapeError expected actual = @@ -496,6 +555,7 @@ Core.Field { Core.fieldName = (Core.Name "actual"), Core.fieldTerm = (Typed.unTypedTerm actual)}]})) + -- | DSL accessor for the actual field of hydra.errors.UnexpectedShapeError unexpectedShapeErrorActual :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm String unexpectedShapeErrorActual x = @@ -504,6 +564,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnexpectedShapeError"), Core.projectionFieldName = (Core.Name "actual")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expected field of hydra.errors.UnexpectedShapeError unexpectedShapeErrorExpected :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm String unexpectedShapeErrorExpected x = @@ -512,6 +573,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnexpectedShapeError"), Core.projectionFieldName = (Core.Name "expected")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -528,6 +590,7 @@ Core.Field { Core.fieldName = (Core.Name "actual"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the expected field of hydra.errors.UnexpectedShapeError unexpectedShapeErrorWithExpected :: Typed.TypedTerm Errors.UnexpectedShapeError -> Typed.TypedTerm String -> Typed.TypedTerm Errors.UnexpectedShapeError unexpectedShapeErrorWithExpected original newVal = @@ -544,6 +607,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnexpectedShapeError"), Core.projectionFieldName = (Core.Name "actual")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.errors.UnificationError unificationError :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm String -> Typed.TypedTerm Errors.UnificationError unificationError leftType rightType message = @@ -559,6 +623,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm message)}]})) + -- | DSL accessor for the leftType field of hydra.errors.UnificationError unificationErrorLeftType :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Core.Type unificationErrorLeftType x = @@ -567,6 +632,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationError"), Core.projectionFieldName = (Core.Name "leftType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the message field of hydra.errors.UnificationError unificationErrorMessage :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm String unificationErrorMessage x = @@ -575,6 +641,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the rightType field of hydra.errors.UnificationError unificationErrorRightType :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Core.Type unificationErrorRightType x = @@ -583,6 +650,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationError"), Core.projectionFieldName = (Core.Name "rightType")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -606,6 +674,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the message field of hydra.errors.UnificationError unificationErrorWithMessage :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm String -> Typed.TypedTerm Errors.UnificationError unificationErrorWithMessage original newVal = @@ -629,6 +698,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the rightType field of hydra.errors.UnificationError unificationErrorWithRightType :: Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Errors.UnificationError unificationErrorWithRightType original newVal = @@ -652,6 +722,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.errors.UnificationInferenceError unificationInferenceError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Errors.UnificationInferenceError unificationInferenceError path cause = @@ -664,6 +735,7 @@ Core.Field { Core.fieldName = (Core.Name "cause"), Core.fieldTerm = (Typed.unTypedTerm cause)}]})) + -- | DSL accessor for the cause field of hydra.errors.UnificationInferenceError unificationInferenceErrorCause :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Errors.UnificationError unificationInferenceErrorCause x = @@ -672,6 +744,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationInferenceError"), Core.projectionFieldName = (Core.Name "cause")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the path field of hydra.errors.UnificationInferenceError unificationInferenceErrorPath :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Paths.SubtermPath unificationInferenceErrorPath x = @@ -680,6 +753,7 @@ Core.projectionTypeName = (Core.Name "hydra.errors.UnificationInferenceError"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the cause field of hydra.errors.UnificationInferenceError unificationInferenceErrorWithCause :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Errors.UnificationError -> Typed.TypedTerm Errors.UnificationInferenceError unificationInferenceErrorWithCause original newVal = @@ -696,6 +770,7 @@ Core.Field { Core.fieldName = (Core.Name "cause"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the path field of hydra.errors.UnificationInferenceError unificationInferenceErrorWithPath :: Typed.TypedTerm Errors.UnificationInferenceError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Errors.UnificationInferenceError unificationInferenceErrorWithPath original newVal = diff --git a/src/main/haskell/Hydra/Dsl/File.hs b/src/main/haskell/Hydra/Dsl/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/File.hs @@ -0,0 +1,363 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.file + +module Hydra.Dsl.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.Time as DslTime +import qualified Hydra.File as File +import qualified Hydra.Time as Time +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.Int as I + +-- | DSL constructor for the hydra.file.FileExtension wrapper +fileExtension :: Typed.TypedTerm String -> Typed.TypedTerm File.FileExtension +fileExtension x = + Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.file.FileExtension"), + Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL constructor for the hydra.file.FilePath wrapper +filePath :: Typed.TypedTerm String -> Typed.TypedTerm File.FilePath +filePath x = + Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.file.FilePath"), + Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | 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 = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Typed.unTypedTerm fileType)}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Typed.unTypedTerm size)}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Typed.unTypedTerm modificationTime)}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Typed.unTypedTerm accessTime)}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Typed.unTypedTerm statusChangeTime)}]})) + +-- | DSL accessor for the accessTime field of hydra.file.FileStatus +fileStatusAccessTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm (Maybe Time.Timespec) +fileStatusAccessTime x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "accessTime")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the fileType field of hydra.file.FileStatus +fileStatusFileType :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm File.FileType +fileStatusFileType x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "fileType")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the modificationTime field of hydra.file.FileStatus +fileStatusModificationTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm Time.Timespec +fileStatusModificationTime x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "modificationTime")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the size field of hydra.file.FileStatus +fileStatusSize :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm I.Int64 +fileStatusSize x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "size")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the statusChangeTime field of hydra.file.FileStatus +fileStatusStatusChangeTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm (Maybe Time.Timespec) +fileStatusStatusChangeTime x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "statusChangeTime")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the accessTime field of hydra.file.FileStatus +fileStatusWithAccessTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm (Maybe Time.Timespec) -> Typed.TypedTerm File.FileStatus +fileStatusWithAccessTime original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "fileType")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "size")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "modificationTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "statusChangeTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the fileType field of hydra.file.FileStatus +fileStatusWithFileType :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm File.FileType -> Typed.TypedTerm File.FileStatus +fileStatusWithFileType original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "size")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "modificationTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "accessTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "statusChangeTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the modificationTime field of hydra.file.FileStatus +fileStatusWithModificationTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm Time.Timespec -> Typed.TypedTerm File.FileStatus +fileStatusWithModificationTime original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "fileType")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "size")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "accessTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "statusChangeTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the size field of hydra.file.FileStatus +fileStatusWithSize :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm File.FileStatus +fileStatusWithSize original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "fileType")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "modificationTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "accessTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "statusChangeTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the statusChangeTime field of hydra.file.FileStatus +fileStatusWithStatusChangeTime :: Typed.TypedTerm File.FileStatus -> Typed.TypedTerm (Maybe Time.Timespec) -> Typed.TypedTerm File.FileStatus +fileStatusWithStatusChangeTime original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "fileType")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "size")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "modificationTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.file.FileStatus"), + Core.projectionFieldName = (Core.Name "accessTime")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL injection for the block variant of hydra.file.FileType +fileTypeBlock :: Typed.TypedTerm File.FileType +fileTypeBlock = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "block"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the character variant of hydra.file.FileType +fileTypeCharacter :: Typed.TypedTerm File.FileType +fileTypeCharacter = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "character"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the directory variant of hydra.file.FileType +fileTypeDirectory :: Typed.TypedTerm File.FileType +fileTypeDirectory = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "directory"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the fifo variant of hydra.file.FileType +fileTypeFifo :: Typed.TypedTerm File.FileType +fileTypeFifo = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "fifo"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the link variant of hydra.file.FileType +fileTypeLink :: Typed.TypedTerm File.FileType +fileTypeLink = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "link"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the regular variant of hydra.file.FileType +fileTypeRegular :: Typed.TypedTerm File.FileType +fileTypeRegular = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "regular"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the socket variant of hydra.file.FileType +fileTypeSocket :: Typed.TypedTerm File.FileType +fileTypeSocket = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "socket"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL accessor for the body of hydra.file.FileExtension +unFileExtension :: Typed.TypedTerm File.FileExtension -> Typed.TypedTerm String +unFileExtension x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.file.FileExtension")), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the body of hydra.file.FilePath +unFilePath :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm String +unFilePath x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.file.FilePath")), + Core.applicationArgument = (Typed.unTypedTerm x)})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.graph module Hydra.Dsl.Graph where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Errors as DslErrors @@ -16,6 +18,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | 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 = @@ -46,6 +49,7 @@ Core.Field { Core.fieldName = (Core.Name "typeVariables"), Core.fieldTerm = (Typed.unTypedTerm typeVariables)}]})) + -- | DSL accessor for the boundTerms field of hydra.graph.Graph graphBoundTerms :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) graphBoundTerms x = @@ -54,6 +58,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "boundTerms")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the boundTypes field of hydra.graph.Graph graphBoundTypes :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) graphBoundTypes x = @@ -62,6 +67,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "boundTypes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the classConstraints field of hydra.graph.Graph graphClassConstraints :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) graphClassConstraints x = @@ -70,6 +76,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "classConstraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the lambdaVariables field of hydra.graph.Graph graphLambdaVariables :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (S.Set Core.Name) graphLambdaVariables x = @@ -78,6 +85,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "lambdaVariables")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the metadata field of hydra.graph.Graph graphMetadata :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) graphMetadata x = @@ -86,6 +94,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the primitives field of hydra.graph.Graph graphPrimitives :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Graph.Primitive) graphPrimitives x = @@ -94,6 +103,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "primitives")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the schemaTypes field of hydra.graph.Graph graphSchemaTypes :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) graphSchemaTypes x = @@ -102,6 +112,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "schemaTypes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeVariables field of hydra.graph.Graph graphTypeVariables :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (S.Set Core.Name) graphTypeVariables x = @@ -110,6 +121,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the boundTerms field of hydra.graph.Graph graphWithBoundTerms :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm Graph.Graph graphWithBoundTerms original newVal = @@ -168,6 +180,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the boundTypes field of hydra.graph.Graph graphWithBoundTypes :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm Graph.Graph graphWithBoundTypes original newVal = @@ -226,6 +239,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the classConstraints field of hydra.graph.Graph graphWithClassConstraints :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) -> Typed.TypedTerm Graph.Graph graphWithClassConstraints original newVal = @@ -284,6 +298,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the lambdaVariables field of hydra.graph.Graph graphWithLambdaVariables :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Graph.Graph graphWithLambdaVariables original newVal = @@ -342,6 +357,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the metadata field of hydra.graph.Graph graphWithMetadata :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm Graph.Graph graphWithMetadata original newVal = @@ -400,6 +416,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the primitives field of hydra.graph.Graph graphWithPrimitives :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Graph.Primitive) -> Typed.TypedTerm Graph.Graph graphWithPrimitives original newVal = @@ -458,6 +475,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the schemaTypes field of hydra.graph.Graph graphWithSchemaTypes :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (M.Map Core.Name Core.TypeScheme) -> Typed.TypedTerm Graph.Graph graphWithSchemaTypes original newVal = @@ -516,6 +534,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Graph"), Core.projectionFieldName = (Core.Name "typeVariables")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeVariables field of hydra.graph.Graph graphWithTypeVariables :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Graph.Graph graphWithTypeVariables original newVal = @@ -574,6 +593,7 @@ Core.Field { Core.fieldName = (Core.Name "typeVariables"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.graph.Library library :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm String -> Typed.TypedTerm [Graph.Primitive] -> Typed.TypedTerm Graph.Library library name prefix primitives = @@ -589,6 +609,7 @@ Core.Field { Core.fieldName = (Core.Name "primitives"), Core.fieldTerm = (Typed.unTypedTerm primitives)}]})) + -- | DSL accessor for the name field of hydra.graph.Library libraryName :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm Packaging.ModuleName libraryName x = @@ -597,6 +618,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Library"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the prefix field of hydra.graph.Library libraryPrefix :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm String libraryPrefix x = @@ -605,6 +627,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Library"), Core.projectionFieldName = (Core.Name "prefix")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the primitives field of hydra.graph.Library libraryPrimitives :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm [Graph.Primitive] libraryPrimitives x = @@ -613,6 +636,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Library"), Core.projectionFieldName = (Core.Name "primitives")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.graph.Library libraryWithName :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Graph.Library libraryWithName original newVal = @@ -636,6 +660,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Library"), Core.projectionFieldName = (Core.Name "primitives")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the prefix field of hydra.graph.Library libraryWithPrefix :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm String -> Typed.TypedTerm Graph.Library libraryWithPrefix original newVal = @@ -659,6 +684,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Library"), Core.projectionFieldName = (Core.Name "primitives")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the primitives field of hydra.graph.Library libraryWithPrimitives :: Typed.TypedTerm Graph.Library -> Typed.TypedTerm [Graph.Primitive] -> Typed.TypedTerm Graph.Library libraryWithPrimitives original newVal = @@ -682,6 +708,7 @@ Core.Field { Core.fieldName = (Core.Name "primitives"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.graph.Primitive primitive :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm (Graph.Graph -> [Core.Term] -> Either Errors.Error Core.Term) -> Typed.TypedTerm Graph.Primitive primitive definition implementation = @@ -694,6 +721,7 @@ Core.Field { Core.fieldName = (Core.Name "implementation"), Core.fieldTerm = (Typed.unTypedTerm implementation)}]})) + -- | DSL accessor for the definition field of hydra.graph.Primitive primitiveDefinition :: Typed.TypedTerm Graph.Primitive -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinition x = @@ -702,6 +730,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Primitive"), Core.projectionFieldName = (Core.Name "definition")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the implementation field of hydra.graph.Primitive primitiveImplementation :: Typed.TypedTerm Graph.Primitive -> Typed.TypedTerm (Graph.Graph -> [Core.Term] -> Either Errors.Error Core.Term) primitiveImplementation x = @@ -710,6 +739,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Primitive"), Core.projectionFieldName = (Core.Name "implementation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -726,6 +756,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.Primitive"), Core.projectionFieldName = (Core.Name "implementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the implementation field of hydra.graph.Primitive primitiveWithImplementation :: Typed.TypedTerm Graph.Primitive -> Typed.TypedTerm (Graph.Graph -> [Core.Term] -> Either Errors.Error Core.Term) -> Typed.TypedTerm Graph.Primitive primitiveWithImplementation original newVal = @@ -742,6 +773,7 @@ Core.Field { Core.fieldName = (Core.Name "implementation"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.graph.TermCoder termCoder :: Typed.TypedTerm Core.Type -> Typed.TypedTerm (Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error a) -> Typed.TypedTerm (Typing.InferenceContext -> a -> Either Errors.Error Core.Term) -> Typed.TypedTerm (Graph.TermCoder a) termCoder type_ encode decode = @@ -757,6 +789,7 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) + -- | DSL accessor for the decode field of hydra.graph.TermCoder termCoderDecode :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm (Typing.InferenceContext -> a -> Either Errors.Error Core.Term) termCoderDecode x = @@ -765,6 +798,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.TermCoder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the encode field of hydra.graph.TermCoder termCoderEncode :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm (Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error a) termCoderEncode x = @@ -773,6 +807,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.TermCoder"), Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.graph.TermCoder termCoderType :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm Core.Type termCoderType x = @@ -781,6 +816,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.TermCoder"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the decode field of hydra.graph.TermCoder termCoderWithDecode :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm (Typing.InferenceContext -> a -> Either Errors.Error Core.Term) -> Typed.TypedTerm (Graph.TermCoder a) termCoderWithDecode original newVal = @@ -804,6 +840,7 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the encode field of hydra.graph.TermCoder termCoderWithEncode :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm (Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error a) -> Typed.TypedTerm (Graph.TermCoder a) termCoderWithEncode original newVal = @@ -827,6 +864,7 @@ Core.projectionTypeName = (Core.Name "hydra.graph.TermCoder"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.graph.TermCoder termCoderWithType :: Typed.TypedTerm (Graph.TermCoder a) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Graph.TermCoder a) termCoderWithType original newVal = 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.json.model module Hydra.Dsl.Json.Model where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Json.Model as Model 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 array variant of hydra.json.model.Value valueArray :: Typed.TypedTerm [Model.Value] -> Typed.TypedTerm Model.Value valueArray x = @@ -16,6 +19,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "array"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the boolean variant of hydra.json.model.Value valueBoolean :: Typed.TypedTerm Bool -> Typed.TypedTerm Model.Value valueBoolean x = @@ -24,6 +28,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "boolean"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the null variant of hydra.json.model.Value valueNull :: Typed.TypedTerm Model.Value valueNull = @@ -32,6 +37,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "null"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the number variant of hydra.json.model.Value valueNumber :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Model.Value valueNumber x = @@ -40,6 +46,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "number"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the object variant of hydra.json.model.Value valueObject :: Typed.TypedTerm [(String, Model.Value)] -> Typed.TypedTerm Model.Value valueObject x = @@ -48,6 +55,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "object"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the string variant of hydra.json.model.Value valueString :: Typed.TypedTerm String -> Typed.TypedTerm Model.Value valueString x = diff --git a/src/main/haskell/Hydra/Dsl/Lib/Chars.hs b/src/main/haskell/Hydra/Dsl/Lib/Chars.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Chars.hs @@ -0,0 +1,105 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.chars + +module Hydra.Dsl.Lib.Chars 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.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.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.chars.isAlphaNum +isAlphaNum :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isAlphaNum arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isAlphaNum")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.chars.isLower +isLower :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isLower arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isLower")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.chars.isSpace +isSpace :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isSpace arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isSpace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.chars.isUpper +isUpper :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +isUpper arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.isUpper")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.chars.toLower +toLower :: Typed.TypedTerm Int -> Typed.TypedTerm Int +toLower arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.toLower")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.chars.toUpper +toUpper :: Typed.TypedTerm Int -> Typed.TypedTerm Int +toUpper arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.chars.toUpper")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs b/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Eithers.hs @@ -0,0 +1,195 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.eithers + +module Hydra.Dsl.Lib.Eithers 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.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.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.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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.eithers.fromRight +fromRight :: Typed.TypedTerm y -> Typed.TypedTerm (Either x y) -> Typed.TypedTerm y +fromRight arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.eithers.isLeft +isLeft :: Typed.TypedTerm (Either x y) -> Typed.TypedTerm Bool +isLeft arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.isLeft")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.eithers.isRight +isRight :: Typed.TypedTerm (Either x y) -> Typed.TypedTerm Bool +isRight arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.isRight")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.eithers.lefts +lefts :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm [x] +lefts arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.lefts")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.eithers.partitionEithers +partitionEithers :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm ([x], [y]) +partitionEithers arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.partitionEithers")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.eithers.rights +rights :: Typed.TypedTerm [Either x y] -> Typed.TypedTerm [y] +rights arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.rights")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Equality.hs b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs @@ -0,0 +1,142 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.equality + +module Hydra.Dsl.Lib.Equality 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.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.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.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 = + 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)})) + +-- | DSL reference to hydra.lib.equality.min +min :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x +min arg0 arg1 = + 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)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Lists.hs b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs @@ -0,0 +1,372 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.lists + +module Hydra.Dsl.Lib.Lists 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.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.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.lists.apply +apply :: Typed.TypedTerm [x -> y] -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] +apply arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.bind +bind :: Typed.TypedTerm [x] -> Typed.TypedTerm (x -> [y]) -> Typed.TypedTerm [y] +bind arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.concat +concat :: Typed.TypedTerm [[x]] -> Typed.TypedTerm [x] +concat arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.concat")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.concat2 +concat2 :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +concat2 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.cons +cons :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +cons arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.drop +drop :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +drop arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.dropWhile +dropWhile :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +dropWhile arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.filter +filter :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +filter arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.find +find :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +find arg0 arg1 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.lists.group +group :: Typed.TypedTerm [x] -> Typed.TypedTerm [[x]] +group arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.group")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.intercalate +intercalate :: Typed.TypedTerm [x] -> Typed.TypedTerm [[x]] -> Typed.TypedTerm [x] +intercalate arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.intersperse +intersperse :: Typed.TypedTerm x -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +intersperse arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.length +length :: Typed.TypedTerm [x] -> Typed.TypedTerm Int +length arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.length")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.map +map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] +map arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.maybeAt +maybeAt :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +maybeAt arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.maybeLast +maybeLast :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe x) +maybeLast arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeLast")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.maybeTail +maybeTail :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe [x]) +maybeTail arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.maybeTail")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.nub +nub :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] +nub arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.nub")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.null +null :: Typed.TypedTerm [x] -> Typed.TypedTerm Bool +null arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.null")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.partition +partition :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm ([x], [x]) +partition arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.pure +pure :: Typed.TypedTerm x -> Typed.TypedTerm [x] +pure arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.pure")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.replicate +replicate :: Typed.TypedTerm Int -> Typed.TypedTerm x -> Typed.TypedTerm [x] +replicate arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.reverse +reverse :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] +reverse arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.reverse")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.singleton +singleton :: Typed.TypedTerm x -> Typed.TypedTerm [x] +singleton arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.singleton")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.sort +sort :: Typed.TypedTerm [x] -> Typed.TypedTerm [x] +sort arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.sort")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.sortOn +sortOn :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +sortOn arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.span +span :: Typed.TypedTerm (x -> Bool) -> Typed.TypedTerm [x] -> Typed.TypedTerm ([x], [x]) +span arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.take +take :: Typed.TypedTerm Int -> Typed.TypedTerm [x] -> Typed.TypedTerm [x] +take arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.lists.transpose +transpose :: Typed.TypedTerm [[x]] -> Typed.TypedTerm [[x]] +transpose arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.transpose")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.uncons +uncons :: Typed.TypedTerm [x] -> Typed.TypedTerm (Maybe (x, [x])) +uncons arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.lists.uncons")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.lists.zip +zip :: Typed.TypedTerm [x] -> Typed.TypedTerm [y] -> Typed.TypedTerm [(x, y)] +zip arg0 arg1 = + 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)})) + +-- | 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 = + 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)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Literals.hs b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs @@ -0,0 +1,450 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.literals + +module Hydra.Dsl.Lib.Literals 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.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.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.ByteString as B +import qualified Data.Int as I + +-- | DSL reference to hydra.lib.literals.bigintToDecimal +bigintToDecimal :: Typed.TypedTerm Integer -> Typed.TypedTerm Sci.Scientific +bigintToDecimal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToDecimal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToInt16 +bigintToInt16 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int16 +bigintToInt16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToInt32 +bigintToInt32 :: Typed.TypedTerm Integer -> Typed.TypedTerm Int +bigintToInt32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToInt64 +bigintToInt64 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int64 +bigintToInt64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToInt8 +bigintToInt8 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int8 +bigintToInt8 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToInt8")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToUint16 +bigintToUint16 :: Typed.TypedTerm Integer -> Typed.TypedTerm Int +bigintToUint16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToUint32 +bigintToUint32 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int64 +bigintToUint32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToUint64 +bigintToUint64 :: Typed.TypedTerm Integer -> Typed.TypedTerm Integer +bigintToUint64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.bigintToUint8 +bigintToUint8 :: Typed.TypedTerm Integer -> Typed.TypedTerm I.Int16 +bigintToUint8 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.bigintToUint8")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.binaryToBytes +binaryToBytes :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm [Int] +binaryToBytes arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.decimalToBigint +decimalToBigint :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Integer +decimalToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.decimalToFloat32 +decimalToFloat32 :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Float +decimalToFloat32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToFloat32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.decimalToFloat64 +decimalToFloat64 :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Double +decimalToFloat64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.decimalToFloat64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.float32ToDecimal +float32ToDecimal :: Typed.TypedTerm Float -> Typed.TypedTerm Sci.Scientific +float32ToDecimal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float32ToDecimal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.float32ToFloat64 +float32ToFloat64 :: Typed.TypedTerm Float -> Typed.TypedTerm Double +float32ToFloat64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float32ToFloat64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.float64ToDecimal +float64ToDecimal :: Typed.TypedTerm Double -> Typed.TypedTerm Sci.Scientific +float64ToDecimal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float64ToDecimal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.float64ToFloat32 +float64ToFloat32 :: Typed.TypedTerm Double -> Typed.TypedTerm Float +float64ToFloat32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.float64ToFloat32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.int16ToBigint +int16ToBigint :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Integer +int16ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int16ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.int32ToBigint +int32ToBigint :: Typed.TypedTerm Int -> Typed.TypedTerm Integer +int32ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int32ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.int64ToBigint +int64ToBigint :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Integer +int64ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int64ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.int8ToBigint +int8ToBigint :: Typed.TypedTerm I.Int8 -> Typed.TypedTerm Integer +int8ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.int8ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readBigint +readBigint :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Integer) +readBigint arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.readDecimal +readDecimal :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Sci.Scientific) +readDecimal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readDecimal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readFloat32 +readFloat32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Float) +readFloat32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readFloat32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readFloat64 +readFloat64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Double) +readFloat64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readFloat64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readInt16 +readInt16 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int16) +readInt16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readInt32 +readInt32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) +readInt32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readInt64 +readInt64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int64) +readInt64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readInt64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readInt8 +readInt8 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int8) +readInt8 arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.readUint16 +readUint16 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Int) +readUint16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readUint32 +readUint32 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int64) +readUint32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readUint64 +readUint64 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Integer) +readUint64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.readUint8 +readUint8 :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe I.Int16) +readUint8 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.readUint8")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showBigint +showBigint :: Typed.TypedTerm Integer -> Typed.TypedTerm String +showBigint arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.showDecimal +showDecimal :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm String +showDecimal arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showDecimal")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showFloat32 +showFloat32 :: Typed.TypedTerm Float -> Typed.TypedTerm String +showFloat32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showFloat32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showFloat64 +showFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm String +showFloat64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showFloat64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showInt16 +showInt16 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm String +showInt16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showInt32 +showInt32 :: Typed.TypedTerm Int -> Typed.TypedTerm String +showInt32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showInt64 +showInt64 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm String +showInt64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showInt64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showInt8 +showInt8 :: Typed.TypedTerm I.Int8 -> Typed.TypedTerm String +showInt8 arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.showUint16 +showUint16 :: Typed.TypedTerm Int -> Typed.TypedTerm String +showUint16 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint16")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showUint32 +showUint32 :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm String +showUint32 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint32")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showUint64 +showUint64 :: Typed.TypedTerm Integer -> Typed.TypedTerm String +showUint64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.showUint64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.showUint8 +showUint8 :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm String +showUint8 arg0 = + 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)})) + +-- | DSL reference to hydra.lib.literals.uint16ToBigint +uint16ToBigint :: Typed.TypedTerm Int -> Typed.TypedTerm Integer +uint16ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint16ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.uint32ToBigint +uint32ToBigint :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm Integer +uint32ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint32ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.uint64ToBigint +uint64ToBigint :: Typed.TypedTerm Integer -> Typed.TypedTerm Integer +uint64ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint64ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.literals.uint8ToBigint +uint8ToBigint :: Typed.TypedTerm I.Int16 -> Typed.TypedTerm Integer +uint8ToBigint arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.literals.uint8ToBigint")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Logic.hs b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs @@ -0,0 +1,99 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.logic + +module Hydra.Dsl.Lib.Logic 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.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.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.logic.and +and :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool +and arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.logic.ifElse +ifElse :: Typed.TypedTerm Bool -> Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x +ifElse 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.lib.logic.ifElse")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lib.logic.not +not :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool +not arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.logic.not")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.logic.or +or :: Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool +or arg0 arg1 = + 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)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Maps.hs b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs @@ -0,0 +1,235 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.maps + +module Hydra.Dsl.Lib.Maps 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.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.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.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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.maps.elems +elems :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [v]) +elems arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.elems")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.maps.empty +empty :: Ord k => (Typed.TypedTerm (M.Map k v)) +empty = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.maps.empty")) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.maps.fromList +fromList :: Ord k => (Typed.TypedTerm [(k, v)] -> Typed.TypedTerm (M.Map k v)) +fromList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.fromList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.maps.keys +keys :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [k]) +keys arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.keys")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.maps.null +null :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm Bool) +null arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.null")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.maps.size +size :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm Int) +size arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.size")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.maps.toList +toList :: Ord k => (Typed.TypedTerm (M.Map k v) -> Typed.TypedTerm [(k, v)]) +toList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Math.hs b/src/main/haskell/Hydra/Dsl/Lib/Math.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Math.hs @@ -0,0 +1,413 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.math + +module Hydra.Dsl.Lib.Math 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.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.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.math.abs +abs :: Typed.TypedTerm Int -> Typed.TypedTerm Int +abs arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.abs")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.acos +acos :: Typed.TypedTerm Double -> Typed.TypedTerm Double +acos arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.acos")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.acosh +acosh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +acosh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.acosh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.add +add :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +add arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.add")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lib.math.addFloat64 +addFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +addFloat64 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.asin +asin :: Typed.TypedTerm Double -> Typed.TypedTerm Double +asin arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.asin")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.asinh +asinh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +asinh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.asinh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.atan +atan :: Typed.TypedTerm Double -> Typed.TypedTerm Double +atan arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.atan")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.atan2 +atan2 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +atan2 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.atanh +atanh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +atanh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.atanh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.ceiling +ceiling :: Typed.TypedTerm Double -> Typed.TypedTerm Double +ceiling arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.ceiling")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.cos +cos :: Typed.TypedTerm Double -> Typed.TypedTerm Double +cos arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.cos")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.cosh +cosh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +cosh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.cosh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.even")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.exp +exp :: Typed.TypedTerm Double -> Typed.TypedTerm Double +exp arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.exp")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.floor +floor :: Typed.TypedTerm Double -> Typed.TypedTerm Double +floor arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.floor")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.log +log :: Typed.TypedTerm Double -> Typed.TypedTerm Double +log arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.log")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.logBase +logBase :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +logBase arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.min +min :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +min arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.mul +mul :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +mul arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mul")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lib.math.mulFloat64 +mulFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +mulFloat64 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.negate +negate :: Typed.TypedTerm Int -> Typed.TypedTerm Int +negate arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.negate")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.negateFloat64 +negateFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double +negateFloat64 arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.negateFloat64")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.odd +odd :: Typed.TypedTerm Int -> Typed.TypedTerm Bool +odd arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.odd")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.pi +pi :: Typed.TypedTerm Double +pi = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.math.pi")) + +-- | DSL reference to hydra.lib.math.pow +pow :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +pow arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.range +range :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm [Int] +range arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.round +round :: Typed.TypedTerm Double -> Typed.TypedTerm Double +round arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.round")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.roundFloat32 +roundFloat32 :: Typed.TypedTerm Int -> Typed.TypedTerm Float -> Typed.TypedTerm Float +roundFloat32 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.roundFloat64 +roundFloat64 :: Typed.TypedTerm Int -> Typed.TypedTerm Double -> Typed.TypedTerm Double +roundFloat64 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.signum +signum :: Typed.TypedTerm Int -> Typed.TypedTerm Int +signum arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.signum")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.sin +sin :: Typed.TypedTerm Double -> Typed.TypedTerm Double +sin arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sin")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.sinh +sinh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +sinh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sinh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.sqrt +sqrt :: Typed.TypedTerm Double -> Typed.TypedTerm Double +sqrt arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sqrt")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.sub +sub :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Int +sub arg0 arg1 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.sub")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})) + +-- | DSL reference to hydra.lib.math.subFloat64 +subFloat64 :: Typed.TypedTerm Double -> Typed.TypedTerm Double -> Typed.TypedTerm Double +subFloat64 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.math.tan +tan :: Typed.TypedTerm Double -> Typed.TypedTerm Double +tan arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.tan")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.tanh +tanh :: Typed.TypedTerm Double -> Typed.TypedTerm Double +tanh arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.tanh")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.math.truncate +truncate :: Typed.TypedTerm Double -> Typed.TypedTerm Double +truncate arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.truncate")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs @@ -0,0 +1,165 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.optionals + +module Hydra.Dsl.Lib.Optionals 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.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.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.optionals.apply +apply :: Typed.TypedTerm (Maybe (x -> y)) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (Maybe y) +apply arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.optionals.bind +bind :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm (Maybe y) +bind arg0 arg1 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.optionals.fromOptional +fromOptional :: Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm x +fromOptional arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.optionals.isGiven +isGiven :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm Bool +isGiven arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.isGiven")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.optionals.isNone +isNone :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm Bool +isNone arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.isNone")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.optionals.map +map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (Maybe y) +map arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.optionals.mapOptional +mapOptional :: Typed.TypedTerm (x -> Maybe y) -> Typed.TypedTerm [x] -> Typed.TypedTerm [y] +mapOptional arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.optionals.pure +pure :: Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) +pure arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.pure")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.optionals.toList +toList :: Typed.TypedTerm (Maybe x) -> Typed.TypedTerm [x] +toList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.toList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs b/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Pairs.hs @@ -0,0 +1,88 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.pairs + +module Hydra.Dsl.Lib.Pairs 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.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.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.pairs.bimap +bimap :: Typed.TypedTerm (a -> c) -> Typed.TypedTerm (b -> d) -> Typed.TypedTerm (a, b) -> Typed.TypedTerm (c, d) +bimap 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.lib.pairs.bimap")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lib.pairs.first +first :: Typed.TypedTerm (a, b) -> Typed.TypedTerm a +first arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.first")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.pairs.second +second :: Typed.TypedTerm (a, b) -> Typed.TypedTerm b +second arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.pairs.second")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Regex.hs b/src/main/haskell/Hydra/Dsl/Lib/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Regex.hs @@ -0,0 +1,121 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.regex + +module Hydra.Dsl.Lib.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.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.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.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.regex.find +find :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm (Maybe String) +find arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.regex.findAll +findAll :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] +findAll arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.regex.matches +matches :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Bool +matches arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.regex.replace +replace :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String +replace 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.lib.regex.replace")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lib.regex.replaceAll +replaceAll :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String +replaceAll 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.lib.regex.replaceAll")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})), + Core.applicationArgument = (Typed.unTypedTerm arg1)})), + Core.applicationArgument = (Typed.unTypedTerm arg2)})) + +-- | DSL reference to hydra.lib.regex.split +split :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] +split arg0 arg1 = + 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)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Sets.hs b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs @@ -0,0 +1,173 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.sets + +module Hydra.Dsl.Lib.Sets 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.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.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.lib.sets.delete +delete :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (S.Set x)) +delete arg0 arg1 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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.fromList +fromList :: Ord x => (Typed.TypedTerm [x] -> Typed.TypedTerm (S.Set x)) +fromList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.fromList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.sets.member +member :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Bool) +member arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.sets.null +null :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Bool) +null arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.null")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.sets.singleton +singleton :: Ord x => (Typed.TypedTerm x -> Typed.TypedTerm (S.Set x)) +singleton arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.singleton")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.sets.size +size :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm Int) +size arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.size")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.sets.toList +toList :: Ord x => (Typed.TypedTerm (S.Set x) -> Typed.TypedTerm [x]) +toList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | 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 = + 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)})) + +-- | DSL reference to hydra.lib.sets.unions +unions :: Ord x => (Typed.TypedTerm [S.Set x] -> Typed.TypedTerm (S.Set x)) +unions arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.unions")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Lib/Strings.hs b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs @@ -0,0 +1,162 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.lib.strings + +module Hydra.Dsl.Lib.Strings 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.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.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.strings.cat +cat :: Typed.TypedTerm [String] -> Typed.TypedTerm String +cat arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.cat")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.cat2 +cat2 :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm String +cat2 arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.strings.fromList +fromList :: Typed.TypedTerm [Int] -> Typed.TypedTerm String +fromList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.fromList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.intercalate +intercalate :: Typed.TypedTerm String -> Typed.TypedTerm [String] -> Typed.TypedTerm String +intercalate arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.strings.length +length :: Typed.TypedTerm String -> Typed.TypedTerm Int +length arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.length")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.lines +lines :: Typed.TypedTerm String -> Typed.TypedTerm [String] +lines arg0 = + 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)})) + +-- | DSL reference to hydra.lib.strings.null +null :: Typed.TypedTerm String -> Typed.TypedTerm Bool +null arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.null")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.splitOn +splitOn :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm [String] +splitOn arg0 arg1 = + 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)})) + +-- | DSL reference to hydra.lib.strings.toList +toList :: Typed.TypedTerm String -> Typed.TypedTerm [Int] +toList arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toList")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.toLower +toLower :: Typed.TypedTerm String -> Typed.TypedTerm String +toLower arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toLower")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.toUpper +toUpper :: Typed.TypedTerm String -> Typed.TypedTerm String +toUpper arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.toUpper")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) + +-- | DSL reference to hydra.lib.strings.unlines +unlines :: Typed.TypedTerm [String] -> Typed.TypedTerm String +unlines arg0 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.strings.unlines")), + Core.applicationArgument = (Typed.unTypedTerm arg0)})) diff --git a/src/main/haskell/Hydra/Dsl/Libraries.hs b/src/main/haskell/Hydra/Dsl/Libraries.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Libraries.hs +++ /dev/null @@ -1,422 +0,0 @@ - --- | Implementations of the Hydra standard libraries in Haskell -module Hydra.Dsl.Libraries ( - module Hydra.Dsl.Libraries, -) where - -import Hydra.Kernel -import Hydra.Dsl.Prims as Prims -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types - -import qualified Hydra.Haskell.Lib.Chars as Chars -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Regex as Regex -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings -import qualified Hydra.Lib.Chars as DefChars -import qualified Hydra.Lib.Eithers as DefEithers -import qualified Hydra.Lib.Equality as DefEquality -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.Pairs as DefPairs -import qualified Hydra.Lib.Regex as DefRegex -import qualified Hydra.Lib.Sets as DefSets -import qualified Hydra.Lib.Strings as DefStrings - -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" -b_ = variable "b" -c_ = variable "c" -d_ = variable "d" -k_ = variable "k" -k1_ = variable "k1" -k2_ = variable "k2" -s_ = variable "s" -v_ = variable "v" -v1_ = variable "v1" -v2_ = variable "v2" -w_ = variable "w" -x_ = variable "x" -y_ = variable "y" -z_ = variable "z" - --- | A TermCoder for function types which uses beta reduction to bridge term-level --- functions to native functions. This allows higher-order primitives like map, --- filter, foldl, etc. to use native implementations rather than eval-level ones. --- Used by the DYNAMIC higher-order primitives (those that must inspect a reduced --- per-element application result), pending their migration to term-level --- defaultImplementations under issue #446. -fun :: TermCoder x -> TermCoder y -> TermCoder (x -> y) -fun = Prims.functionWithReduce (\cx g t -> reduceTerm cx g True t) - --- | A graph-free TermCoder for function types (issue #446): the bridged native function builds an --- unreduced @apply funTerm argTerm@ term and lets the outer reducer fold it, rather than calling --- the reducer here. Used by the STATIC higher-order primitives — those whose result shape is fixed --- by the (already-reduced) data argument's spine, so they never inspect a reduced per-element --- application. This is the form that requires no InferenceContext/Graph, enabling the carrier drop. -funT :: TermCoder x -> TermCoder y -> TermCoder (x -> y) -funT = Prims.functionDeferred - -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] - -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_)] - -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_] - -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_)] - -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] - -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] - -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] - 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] - -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)] - -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_)] - -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_] - -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)] - -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_)] - -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] - -standardLibraries :: [Library] -standardLibraries = [ - hydraLibChars, - hydraLibEithers, - hydraLibEquality, - hydraLibLists, - hydraLibLiterals, - hydraLibLogic, - hydraLibMaps, - hydraLibMathFloat64, - hydraLibMathInt32, - hydraLibOptionals, - hydraLibPairs, - hydraLibRegex, - hydraLibSets, - hydraLibStrings] - --- | Assemble a library from its primitives. The library's module name (e.g. "hydra.lib.chars") --- is *derived* from the primitives' shared namespace rather than passed as a literal string (#473): --- every primitive in a library shares the namespace, so it is read off the first one's --- PrimitiveDefinition name. Fails loudly on an empty list. -standardLibrary :: [Primitive] -> Library -standardLibrary [] = error "standardLibrary: empty primitive list (cannot derive module name)" -standardLibrary prims = Library { - libraryName = ns, - libraryPrefix = L.drop (L.length ("hydra.lib." :: String)) $ unModuleName ns, - libraryPrimitives = prims} - where - -- namespace = the primitive name with its final "." segment dropped - firstName = unName $ primitiveDefinitionName $ primitiveDefinition $ head prims - ns = ModuleName $ reverse $ L.drop 1 $ L.dropWhile (/= '.') $ reverse firstName diff --git a/src/main/haskell/Hydra/Dsl/LiteralTypes.hs b/src/main/haskell/Hydra/Dsl/LiteralTypes.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/LiteralTypes.hs +++ /dev/null @@ -1,86 +0,0 @@ --- | A DSL for Hydra literal types in Haskell - -module Hydra.Dsl.LiteralTypes where - -import Hydra.Core - - --- | Arbitrary-precision integer type --- Example: bigint -bigint :: LiteralType -bigint = LiteralTypeInteger IntegerTypeBigint - --- | Binary data type --- Example: binary -binary :: LiteralType -binary = LiteralTypeBinary - --- | Boolean type --- Example: boolean -boolean :: LiteralType -boolean = LiteralTypeBoolean - --- | Create a floating point type with the specified precision --- Example: float FloatTypeFloat32 -float :: FloatType -> LiteralType -float = LiteralTypeFloat - --- | 32-bit floating point type --- Example: float32 -float32 :: LiteralType -float32 = float FloatTypeFloat32 - --- | 64-bit floating point type --- Example: float64 -float64 :: LiteralType -float64 = float FloatTypeFloat64 - --- | 16-bit signed integer type --- Example: int16 -int16 :: LiteralType -int16 = integer IntegerTypeInt16 - --- | 32-bit signed integer type --- Example: int32 -int32 :: LiteralType -int32 = integer IntegerTypeInt32 - --- | 64-bit signed integer type --- Example: int64 -int64 :: LiteralType -int64 = integer IntegerTypeInt64 - --- | 8-bit signed integer type --- Example: int8 -int8 :: LiteralType -int8 = integer IntegerTypeInt8 - --- | Create an integer type with the specified bit width --- Example: integer IntegerTypeInt32 -integer :: IntegerType -> LiteralType -integer = LiteralTypeInteger - --- | String type --- Example: string -string :: LiteralType -string = LiteralTypeString - --- | 16-bit unsigned integer type --- Example: uint16 -uint16 :: LiteralType -uint16 = integer IntegerTypeUint16 - --- | 32-bit unsigned integer type --- Example: uint32 -uint32 :: LiteralType -uint32 = integer IntegerTypeUint32 - --- | 64-bit unsigned integer type --- Example: uint64 -uint64 :: LiteralType -uint64 = integer IntegerTypeUint64 - --- | 8-bit unsigned integer type --- Example: uint8 -uint8 :: LiteralType -uint8 = integer IntegerTypeUint8 diff --git a/src/main/haskell/Hydra/Dsl/Literals.hs b/src/main/haskell/Hydra/Dsl/Literals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Literals.hs +++ /dev/null @@ -1,95 +0,0 @@ --- | A DSL for constructing Hydra literal values in Haskell - -module Hydra.Dsl.Literals where - -import Hydra.Core - -import Data.Int -import qualified Data.ByteString as B -import qualified Data.Scientific as Sci - - --- | Create an arbitrary-precision integer literal --- Example: bigint 9223372036854775808 -bigint :: Integer -> Literal -bigint = integer . IntegerValueBigint . fromIntegral - --- | Create a binary data literal --- Example: binary (B.pack [0x48, 0x65, 0x6C, 0x6C, 0x6F]) -binary :: B.ByteString -> Literal -binary = LiteralBinary - --- | Create a boolean literal --- Example: boolean True -boolean :: Bool -> Literal -boolean = LiteralBoolean - --- | Create an arbitrary-precision decimal literal --- Example: decimal (Sci.scientific 314159265359 (-11)) -decimal :: Sci.Scientific -> Literal -decimal = LiteralDecimal - --- | Create a floating-point literal with specified precision --- Example: float (FloatValueFloat32 3.14) -float :: FloatValue -> Literal -float = LiteralFloat - --- | Create a 32-bit floating point literal --- Example: float32 3.14 -float32 :: Float -> Literal -float32 = float . FloatValueFloat32 - --- | Create a 64-bit floating point literal --- Example: float64 3.14159265359 -float64 :: Double -> Literal -float64 = float . FloatValueFloat64 - --- | Create a 16-bit signed integer literal --- Example: int16 32767 -int16 :: Int16 -> Literal -int16 = integer . IntegerValueInt16 . fromIntegral - --- | Create a 32-bit signed integer literal --- Example: int32 42 -int32 :: Int -> Literal -int32 = integer . IntegerValueInt32 - --- | Create a 64-bit signed integer literal --- Example: int64 9223372036854775807 -int64 :: Int64 -> Literal -int64 = integer . IntegerValueInt64 . fromIntegral - --- | Create an 8-bit signed integer literal --- Example: int8 127 -int8 :: Int8 -> Literal -int8 = integer . IntegerValueInt8 . fromIntegral - --- | Create an integer literal with specified bit width --- Example: integer (IntegerValueInt32 42) -integer :: IntegerValue -> Literal -integer = LiteralInteger - --- | Create a string literal --- Example: string "hello world" -string :: String -> Literal -string = LiteralString - --- | Create a 16-bit unsigned integer literal --- Example: uint16 65535 -uint16 :: Int -> Literal -uint16 = integer . IntegerValueUint16 . fromIntegral - --- | Create a 32-bit unsigned integer literal --- Example: uint32 4294967295 -uint32 :: Int64 -> Literal -uint32 = integer . IntegerValueUint32 . fromIntegral - --- | Create a 64-bit unsigned integer literal --- Example: uint64 18446744073709551615 -uint64 :: Integer -> Literal -uint64 = integer . IntegerValueUint64 . fromIntegral - --- | Create an 8-bit unsigned integer literal --- Example: uint8 255 -uint8 :: Int16 -> Literal -uint8 = integer . IntegerValueUint8 . fromIntegral diff --git a/src/main/haskell/Hydra/Dsl/Meta/Base.hs b/src/main/haskell/Hydra/Dsl/Meta/Base.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Base.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | A basis for other DSLs which deal with term-encoded expressions. - -module Hydra.Dsl.Meta.Base ( - module Hydra.Dsl.Meta.Phantoms, - module Hydra.Dsl.Meta.Base, - module Hydra.Dsl.Libraries, -) where - -import Hydra.Kernel -import Hydra.Dsl.Meta.Phantoms(asTerm, AsTerm(..), definitionInModule, el, firstClassType, opt) -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Meta.Core as Core -import Hydra.Dsl.Libraries - -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -infixr 0 >: -(>:) :: String -> a -> (TypedTerm Name, a) -n >: d = (name n, d) - -infixr 0 >>: -(>>:) :: Name -> a -> (TypedTerm Name, a) -n >>: d = (Core.nameLift n, d) - -name :: String -> TypedTerm Name -name s = Core.nameLift $ Name s diff --git a/src/main/haskell/Hydra/Dsl/Meta/Common.hs b/src/main/haskell/Hydra/Dsl/Meta/Common.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Common.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - --- | Common IsString instances for Term and Type, enabling OverloadedStrings - -module Hydra.Dsl.Meta.Common where - -import Hydra.Core -import Hydra.Typed - -import Data.String(IsString(..)) - - -instance IsString Type where fromString = TypeVariable . Name -instance IsString Term where fromString = TermLiteral . LiteralString -instance IsString (TypedTerm a) where fromString = TypedTerm . TermLiteral . LiteralString diff --git a/src/main/haskell/Hydra/Dsl/Meta/Core.hs b/src/main/haskell/Hydra/Dsl/Meta/Core.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Core.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Haskell-specific convenience layer over the generated Hydra.Dsl.Core module. --- Re-exports all generated DSL functions and adds AsTerm-flexible overrides --- for functions commonly called with TypedBinding arguments. - -module Hydra.Dsl.Meta.Core ( - module Hydra.Dsl.Core, - module Hydra.Dsl.Meta.Core, - nameLift, -) where - -import Hydra.Kernel -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms (nameLift, var, (~>)) -import Hydra.Dsl.Core hiding (binding, injection, typeVariable) -import qualified Hydra.Dsl.Core as Gen - --- For helpers -import qualified Hydra.Dsl.Meta.Lib.Equality as Equality -import qualified Hydra.Dsl.Meta.Lib.Lists as Lists -import qualified Hydra.Dsl.Meta.Lib.Logic as Logic - -import qualified Data.Map as M -import Prelude hiding (map, product) - - --- | AsTerm-flexible overrides of generated functions. --- These allow passing TypedBinding values where TypedTerm is expected. - -binding :: AsTerm t Term => TypedTerm Name -> t -> TypedTerm (Maybe TypeScheme) -> TypedTerm Binding -binding n t ts = Gen.binding n (asTerm t) ts - -equalNameList_ :: TypedTerm [Name] -> TypedTerm [Name] -> TypedTerm Bool -equalNameList_ lefts rights = Logic.and - (Equality.equal (Lists.length lefts) (Lists.length rights)) - (Logic.ands $ Lists.zipWith equalName lefts rights) - where - equalName = "left" ~> "right" ~> Equality.equal - (Gen.unName (var "left" :: TypedTerm Name)) - (Gen.unName (var "right" :: TypedTerm Name)) - -equalName_ :: TypedTerm Name -> TypedTerm Name -> TypedTerm Bool -equalName_ left right = Equality.equal (Gen.unName left) (Gen.unName right) - -false :: TypedTerm Term -false = termLiteral $ literalBoolean $ TypedTerm $ TermLiteral $ LiteralBoolean False - -injection :: AsTerm t Name => t -> TypedTerm Field -> TypedTerm Injection -injection n f = Gen.injection (asTerm n) f - -typeVariable :: AsTerm t Name => t -> TypedTerm Type -typeVariable n = Gen.typeVariable (asTerm n) - - --- | Non-standard helpers (used in kernel source modules) diff --git a/src/main/haskell/Hydra/Dsl/Meta/DeepCore.hs b/src/main/haskell/Hydra/Dsl/Meta/DeepCore.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/DeepCore.hs +++ /dev/null @@ -1,172 +0,0 @@ --- | A domain-specific language for constructing Hydra terms in Haskell. --- --- This DSL provides helpers for constructing "deep" terms - i.e., terms that --- represent Hydra terms as data (Term values), as opposed to the shallow DSL --- that works at the Haskell level. -module Hydra.Dsl.Meta.DeepCore where - -import Hydra.Kernel -import Hydra.Dsl.Terms (ToPrimName(..)) -import qualified Hydra.Dsl.Meta.Core as Core -import qualified Hydra.Dsl.Meta.Phantoms as P - -import qualified Data.Char as C -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S - - --------------------------------------------------------------------------------- --- Application operators --------------------------------------------------------------------------------- - --- | Apply a function term to an argument term (infix operator, alias) -(@@@) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -fun @@@ arg = apply fun arg - --- | Apply a function term to an argument term -apply :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -apply lhs rhs = Core.termApplication $ Core.application lhs rhs - --------------------------------------------------------------------------------- --- Case statements and pattern matching --------------------------------------------------------------------------------- - -cases :: Name -> TypedTerm Term -> TypedTerm (Maybe Term) -> [TypedTerm CaseAlternative] -> TypedTerm Term -cases tname arg dflt alts = match tname dflt alts @@@ arg - --- | Create a field (e.g. for injection payloads) -field :: Name -> TypedTerm Term -> TypedTerm Field -field fname body = Core.field (Core.nameLift fname) body - --- | Create a case alternative (a variant tag together with its handler) for case matching -caseAlternative :: Name -> TypedTerm Term -> TypedTerm CaseAlternative -caseAlternative aname handler = Core.caseAlternative (Core.nameLift aname) handler - --- | Create a union case statement with optional default case -match :: Name -> TypedTerm (Maybe Term) -> [TypedTerm CaseAlternative] -> TypedTerm Term -match tname dflt alts = Core.termCases $ - Core.caseStatement - (Core.nameLift tname) - dflt - (P.list alts) - --------------------------------------------------------------------------------- --- Functions and lambdas --------------------------------------------------------------------------------- - -constant :: TypedTerm Term -> TypedTerm Term -constant = lambda ignoredVariable - --- | Create a lambda term with a variable name and body -lambda :: String -> TypedTerm Term -> TypedTerm Term -lambda v body = Core.termLambda $ Core.lambda (Core.name (P.string v)) P.nothing $ body - --- | Create a lambda term with a dynamic parameter name, optional domain, and body -lambdaTyped :: TypedTerm Name -> TypedTerm (Maybe Type) -> TypedTerm Term -> TypedTerm Term -lambdaTyped name domain body = Core.termLambda $ Core.lambda name domain body - --- | Create a reference to a primitive function. --- Uses termVariable; the name resolves via graphPrimitives fallthrough. -primitive :: ToPrimName n => n -> TypedTerm Term -primitive = Core.termVariable . Core.nameLift . toPrimName - --- TODO: this is probably equivalent to `primitive`. --- | Create a reference to a primitive function using encodedName --- (for primitives that need namespace encoding) -primitiveEncoded :: ToPrimName n => n -> TypedTerm Term -primitiveEncoded = Core.termVariable . P.encodedName . toPrimName - --------------------------------------------------------------------------------- --- Projections and eliminations --------------------------------------------------------------------------------- - --- | Create a record field projection -project :: Name -> Name -> TypedTerm Term -project tname fname = Core.termProject $ - Core.projection (Core.nameLift tname) (Core.nameLift fname) - -unwrap :: Name -> TypedTerm Term -unwrap name = unwrapDynamic (Core.nameLift name) - --- | Create an unwrap elimination for a wrapped type -unwrapDynamic :: TypedTerm Name -> TypedTerm Term -unwrapDynamic tname = Core.termUnwrap tname - --------------------------------------------------------------------------------- --- Literals and basic terms --------------------------------------------------------------------------------- - --- | Create a string literal term -string :: TypedTerm String -> TypedTerm Term -string s = Core.termLiteral $ Core.literalString s - --- | Create a unit term -unit :: TypedTerm Term -unit = Core.termUnit - --- | Create a variable reference term -var :: String -> TypedTerm Term -var s = Core.termVariable $ Core.name $ P.string s - --------------------------------------------------------------------------------- --- Compound terms (records, unions, wraps, lists) --------------------------------------------------------------------------------- - --- | Create an Either term (left or right) -either :: TypedTerm (Either Term Term) -> TypedTerm Term -either e = Core.termEither e - --- | Create a union injection term -injection :: Name -> TypedTerm Field -> TypedTerm Term -injection tname fld = Core.termInject $ Core.injection (Core.nameLift tname) fld - --- | Create a Just term -just :: TypedTerm Term -> TypedTerm Term -just (TypedTerm t) = TypedTerm $ TermOptional $ Just t - -left :: TypedTerm Term -> TypedTerm Term -left (TypedTerm t) = Core.termEither $ TypedTerm $ TermEither $ Left t - --- | Create a single let binding -letn :: String -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -letn name value body = lets [(name, value)] body - --- | Create a let expression with bindings and a body --- Each binding is a (name, term) pair -lets :: [(String, TypedTerm Term)] -> TypedTerm Term -> TypedTerm Term -lets bindings body = Core.termLet $ Core.let_ - (P.list [Core.binding (Core.name (P.string n)) t P.nothing | (n, t) <- bindings]) - body - --- | Create a list term from a list of terms -list :: TypedTerm [Term] -> TypedTerm Term -list terms = Core.termList terms - -map :: TypedTerm (M.Map Term Term) -> TypedTerm Term -map terms = Core.termMap terms - --- | Create a Nothing term -nothing :: TypedTerm Term -nothing = TypedTerm $ TermOptional Nothing - -pair :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -pair (TypedTerm first) (TypedTerm second) = Core.termPair $ TypedTerm $ TermPair (first, second) - --- | Create a record term with a type name and fields -record :: Name -> [TypedTerm Field] -> TypedTerm Term -record tname fields = Core.termRecord $ Core.record (Core.nameLift tname) (P.list fields) - -ref :: TypedTermDefinition a -> TypedTerm Term -ref (TypedTermDefinition name _) = Core.termVariable $ Core.nameLift name - -right :: TypedTerm Term -> TypedTerm Term -right (TypedTerm t) = Core.termEither $ TypedTerm $ TermEither $ Right t - --- | Create a wrap term with a type name and body -wrap :: Name -> TypedTerm Term -> TypedTerm Term -wrap tname body = Core.termWrap $ Core.wrappedTerm (Core.nameLift tname) body - --- | Create a wrap term with a dynamic type name (TypedTerm Name) -wrapDynamic :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term -wrapDynamic tname body = Core.termWrap $ Core.wrappedTerm tname body diff --git a/src/main/haskell/Hydra/Dsl/Meta/Graph.hs b/src/main/haskell/Hydra/Dsl/Meta/Graph.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Graph.hs +++ /dev/null @@ -1,38 +0,0 @@ --- | Haskell-specific convenience layer over the generated Hydra.Dsl.Graph module. --- Re-exports all generated DSL functions and adds non-standard helpers. - -module Hydra.Dsl.Meta.Graph ( - module Hydra.Dsl.Graph, - module Hydra.Dsl.Meta.Graph, -) where - -import Hydra.Kernel -import Hydra.Dsl.Meta.Phantoms -import Hydra.Dsl.Graph - -import qualified Hydra.Dsl.Meta.Lib.Maps as Maps -import qualified Hydra.Dsl.Meta.Lib.Sets as Sets - - --- | Non-standard helpers - -comparisonEqualTo :: TypedTerm Comparison -comparisonEqualTo = injectUnit _Comparison _Comparison_equalTo - -comparisonGreaterThan :: TypedTerm Comparison -comparisonGreaterThan = injectUnit _Comparison _Comparison_greaterThan - -comparisonLessThan :: TypedTerm Comparison -comparisonLessThan = injectUnit _Comparison _Comparison_lessThan - -emptyGraph :: TypedTerm Graph -emptyGraph = graph - Maps.empty -- boundTerms - Maps.empty -- boundTypes - Maps.empty -- classConstraints - Sets.empty -- lambdaVariables - Maps.empty -- metadata - Maps.empty -- primitives - Maps.empty -- schemaTypes - Sets.empty -- typeVariables - diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Chars.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Chars.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Chars.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.chars library - -module Hydra.Dsl.Meta.Lib.Chars where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Chars as DefChars - - --- | Check whether a character is alphanumeric. -isAlphaNum :: TypedTerm Int -> TypedTerm Bool -isAlphaNum = primitive1 DefChars.isAlphaNum - --- | Check whether a character is lowercase. -isLower :: TypedTerm Int -> TypedTerm Bool -isLower = primitive1 DefChars.isLower - --- | Check whether a character is a whitespace character. -isSpace :: TypedTerm Int -> TypedTerm Bool -isSpace = primitive1 DefChars.isSpace - --- | Check whether a character is uppercase. -isUpper :: TypedTerm Int -> TypedTerm Bool -isUpper = primitive1 DefChars.isUpper - --- | Convert a character to lowercase. -toLower :: TypedTerm Int -> TypedTerm Int -toLower = primitive1 DefChars.toLower - --- | Convert a character to uppercase. -toUpper :: TypedTerm Int -> TypedTerm Int -toUpper = primitive1 DefChars.toUpper diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Eithers.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Eithers.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Eithers.hs +++ /dev/null @@ -1,71 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.eithers library - -module Hydra.Dsl.Meta.Lib.Eithers where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Data.Set as S -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Eithers as DefEithers - - --- | Map over both sides of an Either value. -bimap :: TypedTerm (a -> c) -> TypedTerm (b -> d) -> TypedTerm (Either a b) -> TypedTerm (Either c d) -bimap = primitive3 DefEithers.bimap - --- | Bind (flatMap) for Either: if Right, apply the function; if Left, return unchanged. -bind :: TypedTerm (Either a b) -> TypedTerm (b -> Either a c) -> TypedTerm (Either a c) -bind = primitive2 DefEithers.bind - --- | Eliminate an Either value by applying one of two functions. -either_ :: TypedTerm (a -> c) -> TypedTerm (b -> c) -> TypedTerm (Either a b) -> TypedTerm c -either_ = primitive3 DefEithers.either - --- | Left-fold over a list with an Either-returning function, short-circuiting on Left. -foldl :: TypedTerm (a -> b -> Either c a) -> TypedTerm a -> TypedTerm [b] -> TypedTerm (Either c a) -foldl = primitive3 DefEithers.foldl - --- | Extract the Left value, or return a default. -fromLeft :: TypedTerm a -> TypedTerm (Either a b) -> TypedTerm a -fromLeft = primitive2 DefEithers.fromLeft - --- | Extract the Right value, or return a default. -fromRight :: TypedTerm b -> TypedTerm (Either a b) -> TypedTerm b -fromRight = primitive2 DefEithers.fromRight - --- | Check if an Either is a Left value. -isLeft :: TypedTerm (Either a b) -> TypedTerm Bool -isLeft = primitive1 DefEithers.isLeft - --- | Check if an Either is a Right value. -isRight :: TypedTerm (Either a b) -> TypedTerm Bool -isRight = primitive1 DefEithers.isRight - --- | Extract all Left values from a list of Eithers. -lefts :: TypedTerm [Either a b] -> TypedTerm [a] -lefts = primitive1 DefEithers.lefts - --- | Map a function over the Right side of an Either (standard functor map). -map :: TypedTerm (a -> b) -> TypedTerm (Either c a) -> TypedTerm (Either c b) -map = primitive2 DefEithers.map - --- | Map a function returning Either over a list, collecting results or short-circuiting on Left. -mapList :: TypedTerm (a -> Either e b) -> TypedTerm [a] -> TypedTerm (Either e [b]) -mapList = primitive2 DefEithers.mapList - --- | Map a function returning Either over an optional, or return Right Nothing if Nothing. -mapOptional :: TypedTerm (a -> Either c b) -> TypedTerm (Maybe a) -> TypedTerm (Either c (Maybe b)) -mapOptional = primitive2 DefEithers.mapOptional - --- | Map a function returning Either over a Set, collecting results or short-circuiting on Left. -mapSet :: TypedTerm (a -> Either c b) -> TypedTerm (S.Set a) -> TypedTerm (Either c (S.Set b)) -mapSet = primitive2 DefEithers.mapSet - --- | Partition a list of Eithers into lefts and rights. -partitionEithers :: TypedTerm [Either a b] -> TypedTerm ([a], [b]) -partitionEithers = primitive1 DefEithers.partitionEithers - --- | Extract all Right values from a list of Eithers. -rights :: TypedTerm [Either a b] -> TypedTerm [b] -rights = primitive1 DefEithers.rights diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Equality.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Equality.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Equality.hs +++ /dev/null @@ -1,52 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.equality library - -{-# LANGUAGE FlexibleContexts #-} - -module Hydra.Dsl.Meta.Lib.Equality where - -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import Hydra.Typed -import Hydra.Util -import qualified Hydra.Dsl.Terms as Terms - -import Data.Int -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Equality as DefEquality - - --- | Compare two values and return a Comparison. -compare :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Comparison -compare t1 t2 = primitive2 DefEquality.compare t1 (asTerm t2) - --- | Check if two values are equal. -equal :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Bool -equal t1 t2 = primitive2 DefEquality.equal t1 (asTerm t2) - --- | Check if first value is greater than second. -gt :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Bool -gt t1 t2 = primitive2 DefEquality.gt t1 (asTerm t2) - --- | Check if first value is greater than or equal to second. -gte :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Bool -gte t1 t2 = primitive2 DefEquality.gte t1 (asTerm t2) - --- | Return a value unchanged. -identity :: TypedTerm a -> TypedTerm a -identity = primitive1 DefEquality.identity - --- | Check if first value is less than second. -lt :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Bool -lt t1 t2 = primitive2 DefEquality.lt t1 (asTerm t2) - --- | Check if first value is less than or equal to second. -lte :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm Bool -lte t1 t2 = primitive2 DefEquality.lte t1 (asTerm t2) - --- | Return the maximum of two values. -max :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm a -max t1 t2 = primitive2 DefEquality.max t1 (asTerm t2) - --- | Return the minimum of two values. -min :: AsTerm t2 a => TypedTerm a -> t2 -> TypedTerm a -min t1 t2 = primitive2 DefEquality.min t1 (asTerm t2) diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Lists.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Lists.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Lists.hs +++ /dev/null @@ -1,161 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.lists library - -{-# LANGUAGE FlexibleContexts #-} - -module Hydra.Dsl.Meta.Lib.Lists where - -import Hydra.Typed -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Lists as DefLists - - --- | Apply a list of functions to a list of values (applicative style). -apply :: TypedTerm [a -> b] -> TypedTerm [a] -> TypedTerm [b] -apply = primitive2 DefLists.apply - --- | Apply a function that returns lists to each element and flatten results. -bind :: TypedTerm [a] -> TypedTerm (a -> [b]) -> TypedTerm [b] -bind = primitive2 DefLists.bind - --- | Concatenate a list of lists. -concat :: TypedTerm [[a]] -> TypedTerm [a] -concat = primitive1 DefLists.concat - --- | Concatenate two lists. -concat2 :: TypedTerm [a] -> TypedTerm [a] -> TypedTerm [a] -concat2 = primitive2 DefLists.concat2 - --- | Prepend a value to a list. -cons :: TypedTerm a -> TypedTerm [a] -> TypedTerm [a] -cons = primitive2 DefLists.cons - --- | Drop the first n elements from a list. -drop :: TypedTerm Int -> TypedTerm [a] -> TypedTerm [a] -drop = primitive2 DefLists.drop - --- | Drop elements from the beginning of a list while predicate is true. -dropWhile :: TypedTerm (a -> Bool) -> TypedTerm [a] -> TypedTerm [a] -dropWhile = primitive2 DefLists.dropWhile - --- | Check if an element is in a list. -elem :: Eq a => TypedTerm a -> TypedTerm [a] -> TypedTerm Bool -elem = primitive2 DefLists.elem - --- | Filter a list based on a predicate. -filter :: AsTerm t [a] => TypedTerm (a -> Bool) -> t -> TypedTerm [a] -filter p xs = primitive2 DefLists.filter p (asTerm xs) - --- | Find the first element matching a predicate. -find :: TypedTerm (a -> Bool) -> TypedTerm [a] -> TypedTerm (Maybe a) -find = primitive2 DefLists.find - --- | Fold a list from the left. -foldl :: AsTerm f (b -> a -> b) => f -> TypedTerm b -> TypedTerm [a] -> TypedTerm b -foldl f = primitive3 DefLists.foldl (asTerm f) - --- | Fold a list from the right. -foldr :: AsTerm f (a -> b -> b) => f -> TypedTerm b -> TypedTerm [a] -> TypedTerm b -foldr f = primitive3 DefLists.foldr (asTerm f) - --- | Group consecutive equal elements. -group :: Eq a => TypedTerm [a] -> TypedTerm [[a]] -group = primitive1 DefLists.group - --- | Intercalate a list of lists with a separator list between each. -intercalate :: TypedTerm [a] -> TypedTerm [[a]] -> TypedTerm [a] -intercalate = primitive2 DefLists.intercalate - --- | Intersperse a value between elements of a list. -intersperse :: TypedTerm a -> TypedTerm [a] -> TypedTerm [a] -intersperse = primitive2 DefLists.intersperse - --- | Get the length of a list. -length :: TypedTerm [a] -> TypedTerm Int -length = primitive1 DefLists.length - --- | Map a function over a list. -map :: (AsTerm f (a -> b), AsTerm t [a]) => f -> t -> TypedTerm [b] -map f l = primitive2 DefLists.map (asTerm f) (asTerm l) - --- | Get the element at a specified index in a list, returning Nothing if out of bounds. -maybeAt :: TypedTerm Int -> TypedTerm [a] -> TypedTerm (Maybe a) -maybeAt = primitive2 DefLists.maybeAt - --- | Get the first element of a list, returning Nothing if the list is empty. -maybeHead :: TypedTerm [a] -> TypedTerm (Maybe a) -maybeHead = primitive1 DefLists.maybeHead - --- | Return all elements except the last one, returning Nothing if the list is empty. -maybeInit :: TypedTerm [a] -> TypedTerm (Maybe [a]) -maybeInit = primitive1 DefLists.maybeInit - --- | Get the last element of a list, returning Nothing if the list is empty. -maybeLast :: TypedTerm [a] -> TypedTerm (Maybe a) -maybeLast = primitive1 DefLists.maybeLast - --- | Get all elements of a list except the first, returning Nothing if the list is empty. -maybeTail :: TypedTerm [a] -> TypedTerm (Maybe [a]) -maybeTail = primitive1 DefLists.maybeTail - --- | Remove duplicate elements from a list. -nub :: Eq a => TypedTerm [a] -> TypedTerm [a] -nub = primitive1 DefLists.nub - --- | Check if a list is empty. -null :: TypedTerm [a] -> TypedTerm Bool -null = primitive1 DefLists.null - --- | Partition a list into elements that satisfy a predicate and elements that do not. -partition :: TypedTerm (a -> Bool) -> TypedTerm [a] -> TypedTerm ([a], [a]) -partition = primitive2 DefLists.partition - --- | Create a list with a single element. -pure :: TypedTerm a -> TypedTerm [a] -pure = primitive1 DefLists.pure - --- | Create a list with n copies of a value. -replicate :: AsTerm t a => TypedTerm Int -> t -> TypedTerm [a] -replicate n x = primitive2 DefLists.replicate n (asTerm x) - --- | Reverse a list. -reverse :: TypedTerm [a] -> TypedTerm [a] -reverse = primitive1 DefLists.reverse - --- | Create a single-element list. -singleton :: TypedTerm a -> TypedTerm [a] -singleton = primitive1 DefLists.singleton - --- | Sort a list. -sort :: TypedTerm [a] -> TypedTerm [a] -sort = primitive1 DefLists.sort - --- | Sort a list based on a key function. -sortOn :: TypedTerm (a -> b) -> TypedTerm [a] -> TypedTerm [a] -sortOn = primitive2 DefLists.sortOn - --- | Split a list at the first element where predicate fails. -span :: TypedTerm (a -> Bool) -> TypedTerm [a] -> TypedTerm ([a], [a]) -span = primitive2 DefLists.span - --- | Take the first n elements from a list. -take :: TypedTerm Int -> TypedTerm [a] -> TypedTerm [a] -take = primitive2 DefLists.take - --- | Transpose a list of lists. -transpose :: TypedTerm [[a]] -> TypedTerm [[a]] -transpose = primitive1 DefLists.transpose - --- | Decompose a list into its head and tail, returning Nothing if the list is empty. -uncons :: TypedTerm [a] -> TypedTerm (Maybe (a, [a])) -uncons = primitive1 DefLists.uncons - --- | Zip two lists into pairs. -zip :: TypedTerm [a] -> TypedTerm [b] -> TypedTerm [(a, b)] -zip = primitive2 DefLists.zip - --- | Zip two lists with a combining function. -zipWith :: TypedTerm (a -> b -> c) -> TypedTerm [a] -> TypedTerm [b] -> TypedTerm [c] -zipWith = primitive3 DefLists.zipWith diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Literals.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Literals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Literals.hs +++ /dev/null @@ -1,234 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.literals library - -module Hydra.Dsl.Meta.Lib.Literals where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms - -import qualified Data.ByteString as B -import qualified Data.Scientific as Sci -import Data.Int -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Literals as DefLiterals - - --- | Convert a bigint (Integer) to a decimal (Scientific). -bigintToDecimal :: TypedTerm Integer -> TypedTerm Sci.Scientific -bigintToDecimal = primitive1 DefLiterals.bigintToDecimal - --- | Convert a bigint (Integer) to an int16. -bigintToInt16 :: TypedTerm Integer -> TypedTerm Int16 -bigintToInt16 = primitive1 DefLiterals.bigintToInt16 - --- | Convert a bigint (Integer) to an int32. -bigintToInt32 :: TypedTerm Integer -> TypedTerm Int -bigintToInt32 = primitive1 DefLiterals.bigintToInt32 - --- | Convert a bigint (Integer) to an int64. -bigintToInt64 :: TypedTerm Integer -> TypedTerm Int64 -bigintToInt64 = primitive1 DefLiterals.bigintToInt64 - --- | Convert a bigint (Integer) to an int8. -bigintToInt8 :: TypedTerm Integer -> TypedTerm Int8 -bigintToInt8 = primitive1 DefLiterals.bigintToInt8 - --- | Convert a bigint (Integer) to a uint16. -bigintToUint16 :: TypedTerm Integer -> TypedTerm Int -bigintToUint16 = primitive1 DefLiterals.bigintToUint16 - --- | Convert a bigint (Integer) to a uint32. -bigintToUint32 :: TypedTerm Integer -> TypedTerm Int64 -bigintToUint32 = primitive1 DefLiterals.bigintToUint32 - --- | Convert a bigint (Integer) to a uint64. -bigintToUint64 :: TypedTerm Integer -> TypedTerm Integer -bigintToUint64 = primitive1 DefLiterals.bigintToUint64 - --- | Convert a bigint (Integer) to a uint8. -bigintToUint8 :: TypedTerm Integer -> TypedTerm Int16 -bigintToUint8 = primitive1 DefLiterals.bigintToUint8 - --- | Convert binary to a list of byte values (0-255). -binaryToBytes :: TypedTerm B.ByteString -> TypedTerm [Int] -binaryToBytes = primitive1 DefLiterals.binaryToBytes - --- | Convert binary to string by base64 encoding. -binaryToString :: TypedTerm B.ByteString -> TypedTerm String -binaryToString = primitive1 DefLiterals.binaryToString - --- | Convert a decimal (Scientific) to a bigint (Integer) by truncating toward zero. -decimalToBigint :: TypedTerm Sci.Scientific -> TypedTerm Integer -decimalToBigint = primitive1 DefLiterals.decimalToBigint - --- | Convert a decimal (Scientific) to a float32 (Float). May lose precision. -decimalToFloat32 :: TypedTerm Sci.Scientific -> TypedTerm Float -decimalToFloat32 = primitive1 DefLiterals.decimalToFloat32 - --- | Convert a decimal (Scientific) to a float64 (Double). May lose precision. -decimalToFloat64 :: TypedTerm Sci.Scientific -> TypedTerm Double -decimalToFloat64 = primitive1 DefLiterals.decimalToFloat64 - --- | Convert a float32 (Float) to a decimal (Scientific). -float32ToDecimal :: TypedTerm Float -> TypedTerm Sci.Scientific -float32ToDecimal = primitive1 DefLiterals.float32ToDecimal - --- | Convert a float32 (Float) to a float64 (Double). -float32ToFloat64 :: TypedTerm Float -> TypedTerm Double -float32ToFloat64 = primitive1 DefLiterals.float32ToFloat64 - --- | Convert a float64 (Double) to a decimal (Scientific). -float64ToDecimal :: TypedTerm Double -> TypedTerm Sci.Scientific -float64ToDecimal = primitive1 DefLiterals.float64ToDecimal - --- | Convert a float64 (Double) to a float32 (Float). May lose precision. -float64ToFloat32 :: TypedTerm Double -> TypedTerm Float -float64ToFloat32 = primitive1 DefLiterals.float64ToFloat32 - --- | Convert an int16 to a bigint (Integer). -int16ToBigint :: TypedTerm Int16 -> TypedTerm Integer -int16ToBigint = primitive1 DefLiterals.int16ToBigint - --- | Convert an int32 to a bigint (Integer). -int32ToBigint :: TypedTerm Int -> TypedTerm Integer -int32ToBigint = primitive1 DefLiterals.int32ToBigint - --- | Convert an int64 to a bigint (Integer). -int64ToBigint :: TypedTerm Int64 -> TypedTerm Integer -int64ToBigint = primitive1 DefLiterals.int64ToBigint - --- | Convert an int8 to a bigint (Integer). -int8ToBigint :: TypedTerm Int8 -> TypedTerm Integer -int8ToBigint = primitive1 DefLiterals.int8ToBigint - --- | Parse a string to a bigint (Integer). -readBigint :: TypedTerm String -> TypedTerm (Maybe Integer) -readBigint = primitive1 DefLiterals.readBigint - --- | Parse a string to a boolean. -readBoolean :: TypedTerm String -> TypedTerm (Maybe Bool) -readBoolean = primitive1 DefLiterals.readBoolean - --- | Parse a string to a decimal (Scientific). -readDecimal :: TypedTerm String -> TypedTerm (Maybe Sci.Scientific) -readDecimal = primitive1 DefLiterals.readDecimal - --- | Parse a string to a float32 (Float). -readFloat32 :: TypedTerm String -> TypedTerm (Maybe Float) -readFloat32 = primitive1 DefLiterals.readFloat32 - --- | Parse a string to a float64 (Double). -readFloat64 :: TypedTerm String -> TypedTerm (Maybe Double) -readFloat64 = primitive1 DefLiterals.readFloat64 - --- | Parse a string to an int16 (-32768 to 32767). -readInt16 :: TypedTerm String -> TypedTerm (Maybe Int16) -readInt16 = primitive1 DefLiterals.readInt16 - --- | Parse a string to an int32. -readInt32 :: TypedTerm String -> TypedTerm (Maybe Int) -readInt32 = primitive1 DefLiterals.readInt32 - --- | Parse a string to an int64. -readInt64 :: TypedTerm String -> TypedTerm (Maybe Int64) -readInt64 = primitive1 DefLiterals.readInt64 - --- | Parse a string to an int8 (-128 to 127). -readInt8 :: TypedTerm String -> TypedTerm (Maybe Int8) -readInt8 = primitive1 DefLiterals.readInt8 - --- | Parse a string literal. -readString :: TypedTerm String -> TypedTerm (Maybe String) -readString = primitive1 DefLiterals.readString - --- | Parse a string to a uint16 (0 to 65535). -readUint16 :: TypedTerm String -> TypedTerm (Maybe Int) -readUint16 = primitive1 DefLiterals.readUint16 - --- | Parse a string to a uint32 (0 to 4294967295). -readUint32 :: TypedTerm String -> TypedTerm (Maybe Int64) -readUint32 = primitive1 DefLiterals.readUint32 - --- | Parse a string to a uint64 (0 to 18446744073709551615). -readUint64 :: TypedTerm String -> TypedTerm (Maybe Integer) -readUint64 = primitive1 DefLiterals.readUint64 - --- | Parse a string to a uint8 (0 to 255). -readUint8 :: TypedTerm String -> TypedTerm (Maybe Int16) -readUint8 = primitive1 DefLiterals.readUint8 - --- | Convert a bigint (Integer) to string. -showBigint :: TypedTerm Integer -> TypedTerm String -showBigint = primitive1 DefLiterals.showBigint - --- | Convert a boolean to string. -showBoolean :: TypedTerm Bool -> TypedTerm String -showBoolean = primitive1 DefLiterals.showBoolean - --- | Convert a decimal (Scientific) to string. -showDecimal :: TypedTerm Sci.Scientific -> TypedTerm String -showDecimal = primitive1 DefLiterals.showDecimal - --- | Convert a float32 (Float) to string. -showFloat32 :: TypedTerm Float -> TypedTerm String -showFloat32 = primitive1 DefLiterals.showFloat32 - --- | Convert a float64 (Double) to string. -showFloat64 :: TypedTerm Double -> TypedTerm String -showFloat64 = primitive1 DefLiterals.showFloat64 - --- | Convert an int16 to string. -showInt16 :: TypedTerm Int16 -> TypedTerm String -showInt16 = primitive1 DefLiterals.showInt16 - --- | Convert an int32 to string. -showInt32 :: TypedTerm Int -> TypedTerm String -showInt32 = primitive1 DefLiterals.showInt32 - --- | Convert an int64 to string. -showInt64 :: TypedTerm Int64 -> TypedTerm String -showInt64 = primitive1 DefLiterals.showInt64 - --- | Convert an int8 to string. -showInt8 :: TypedTerm Int8 -> TypedTerm String -showInt8 = primitive1 DefLiterals.showInt8 - --- | Convert a string to a quoted string representation. -showString :: TypedTerm String -> TypedTerm String -showString = primitive1 DefLiterals.showString - --- | Convert a uint16 to string. -showUint16 :: TypedTerm Int -> TypedTerm String -showUint16 = primitive1 DefLiterals.showUint16 - --- | Convert a uint32 to string. -showUint32 :: TypedTerm Int64 -> TypedTerm String -showUint32 = primitive1 DefLiterals.showUint32 - --- | Convert a uint64 to string. -showUint64 :: TypedTerm Integer -> TypedTerm String -showUint64 = primitive1 DefLiterals.showUint64 - --- | Convert a uint8 to string. -showUint8 :: TypedTerm Int16 -> TypedTerm String -showUint8 = primitive1 DefLiterals.showUint8 - --- | Convert string to binary by base64 decoding. -stringToBinary :: TypedTerm String -> TypedTerm B.ByteString -stringToBinary = primitive1 DefLiterals.stringToBinary - --- | Convert a uint16 to a bigint (Integer). -uint16ToBigint :: TypedTerm Int -> TypedTerm Integer -uint16ToBigint = primitive1 DefLiterals.uint16ToBigint - --- | Convert a uint32 to a bigint (Integer). -uint32ToBigint :: TypedTerm Int64 -> TypedTerm Integer -uint32ToBigint = primitive1 DefLiterals.uint32ToBigint - --- | Convert a uint64 to a bigint (Integer). -uint64ToBigint :: TypedTerm Integer -> TypedTerm Integer -uint64ToBigint = primitive1 DefLiterals.uint64ToBigint - --- | Convert a uint8 to a bigint (Integer). -uint8ToBigint :: TypedTerm Int16 -> TypedTerm Integer -uint8ToBigint = primitive1 DefLiterals.uint8ToBigint diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Logic.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Logic.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Logic.hs +++ /dev/null @@ -1,40 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.logic library - -{-# LANGUAGE FlexibleContexts #-} - -module Hydra.Dsl.Meta.Lib.Logic where - -import Hydra.Typed -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Logic as DefLogic - - --- | Compute the logical AND of two boolean values. -and :: TypedTerm Bool -> TypedTerm Bool -> TypedTerm Bool -and = primitive2 DefLogic.and - --- | Compute a conditional expression. -ifElse :: (AsTerm c Bool, AsTerm t a, AsTerm e a) => c -> t -> e -> TypedTerm a -ifElse cond t e = primitive3 DefLogic.ifElse (asTerm cond) (asTerm t) (asTerm e) - --- | Compute the logical NOT of a boolean value. -not :: TypedTerm Bool -> TypedTerm Bool -not = primitive1 DefLogic.not - --- | Compute the logical OR of two boolean values. -or :: TypedTerm Bool -> TypedTerm Bool -> TypedTerm Bool -or = primitive2 DefLogic.or - ----------------------------------------- --- Helpers which are not primitives - --- | Fold a list of booleans with logical AND, returning True for an empty list. -ands :: TypedTerm [Bool] -> TypedTerm Bool -ands terms = fold (primitive DefLogic.and) @@ true @@ terms - --- | Fold a list of booleans with logical OR, returning False for an empty list. -ors :: TypedTerm [Bool] -> TypedTerm Bool -ors terms = fold (primitive DefLogic.or) @@ false @@ terms diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Maps.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Maps.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Maps.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Phantom-typed term DSL for the hydra.lib.maps library - -module Hydra.Dsl.Meta.Lib.Maps where - -import Hydra.Typed -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms - -import Data.Map -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Maps as DefMaps - - --- | Alter a value at a key using a function. -alter :: TypedTerm (Maybe v -> Maybe v) -> TypedTerm k -> TypedTerm (Map k v) -> TypedTerm (Map k v) -alter = primitive3 DefMaps.alter - --- | Map a function over the keys and values of a map. -bimap :: TypedTerm (k1 -> k2) -> TypedTerm (v1 -> v2) -> TypedTerm (Map k1 v1) -> TypedTerm (Map k2 v2) -bimap = primitive3 DefMaps.bimap - --- | Remove a key from a map. -delete :: TypedTerm k -> TypedTerm (Map k v) -> TypedTerm (Map k v) -delete = primitive2 DefMaps.delete - --- | Get the values of a map. -elems :: TypedTerm (Map k v) -> TypedTerm [v] -elems = primitive1 DefMaps.elems - --- | Create an empty map. -empty :: TypedTerm (Map k v) -empty = primitive DefMaps.empty - --- | Filter a map based on values. -filter :: TypedTerm (v -> Bool) -> TypedTerm (Map k v) -> TypedTerm (Map k v) -filter = primitive2 DefMaps.filter - --- | Filter a map based on key-value pairs. -filterWithKey :: TypedTerm (k -> v -> Bool) -> TypedTerm (Map k v) -> TypedTerm (Map k v) -filterWithKey = primitive2 DefMaps.filterWithKey - --- | Lookup a value with a default. -findWithDefault :: AsTerm t v => t -> TypedTerm k -> TypedTerm (Map k v) -> TypedTerm v -findWithDefault def = primitive3 DefMaps.findWithDefault (asTerm def) - --- | Create a map from a list of key-value pairs. -fromList :: TypedTerm [(k, v)] -> TypedTerm (Map k v) -fromList = primitive1 DefMaps.fromList - --- | Insert a key-value pair into a map. -insert :: TypedTerm k -> TypedTerm v -> TypedTerm (Map k v) -> TypedTerm (Map k v) -insert = primitive3 DefMaps.insert - --- | Get the keys of a map. -keys :: TypedTerm (Map k v) -> TypedTerm [k] -keys = primitive1 DefMaps.keys - --- | Lookup a value in a map. -lookup :: AsTerm t k => t -> TypedTerm (Map k v) -> TypedTerm (Maybe v) -lookup k = primitive2 DefMaps.lookup (asTerm k) - --- | Map a function over a map. -map :: AsTerm f (v1 -> v2) => f -> TypedTerm (Map k v1) -> TypedTerm (Map k v2) -map f = primitive2 DefMaps.map (asTerm f) - --- | Map a function over the keys of a map. -mapKeys :: TypedTerm (k1 -> k2) -> TypedTerm (Map k1 v) -> TypedTerm (Map k2 v) -mapKeys = primitive2 DefMaps.mapKeys - --- | Check if a key is present in a map. -member :: TypedTerm k -> TypedTerm (Map k v) -> TypedTerm Bool -member = primitive2 DefMaps.member - --- | Check if a map is empty. -null :: TypedTerm (Map k v) -> TypedTerm Bool -null = primitive1 DefMaps.null - --- | Create a map with a single key-value pair. -singleton :: TypedTerm k -> TypedTerm v -> TypedTerm (Map k v) -singleton = primitive2 DefMaps.singleton - --- | Get the size of a map. -size :: TypedTerm (Map k v) -> TypedTerm Int -size = primitive1 DefMaps.size - --- | Convert a map to a list of key-value pairs. -toList :: TypedTerm (Map k v) -> TypedTerm [(k, v)] -toList = primitive1 DefMaps.toList - --- | Union two maps, with the first taking precedence. -union :: TypedTerm (Map k v) -> TypedTerm (Map k v) -> TypedTerm (Map k v) -union = primitive2 DefMaps.union diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Math.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Math.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Math.hs +++ /dev/null @@ -1,202 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.math library - -module Hydra.Dsl.Meta.Lib.Math where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Math as DefMath - - --- | Return the absolute value. -abs :: Num a => TypedTerm a -> TypedTerm a -abs = primitive1 DefMath.abs - --- | Return the arc cosine of x in radians. -acos :: TypedTerm Double -> TypedTerm Double -acos = primitive1 DefMath.acos - --- | Return the inverse hyperbolic cosine of x. -acosh :: TypedTerm Double -> TypedTerm Double -acosh = primitive1 DefMath.acosh - --- | Add two numbers. -add :: Num a => TypedTerm a -> TypedTerm a -> TypedTerm a -add = primitive2 DefMath.add - --- | Add two Float64 numbers. -addFloat64 :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -addFloat64 = primitive2 DefMath.addFloat64 - --- | Return the arc sine of x in radians. -asin :: TypedTerm Double -> TypedTerm Double -asin = primitive1 DefMath.asin - --- | Return the inverse hyperbolic sine of x. -asinh :: TypedTerm Double -> TypedTerm Double -asinh = primitive1 DefMath.asinh - --- | Return the arc tangent of x in radians. -atan :: TypedTerm Double -> TypedTerm Double -atan = primitive1 DefMath.atan - --- | Return the arc tangent of y/x in radians, using signs to determine quadrant. -atan2 :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -atan2 = primitive2 DefMath.atan2 - --- | Return the inverse hyperbolic tangent of x. -atanh :: TypedTerm Double -> TypedTerm Double -atanh = primitive1 DefMath.atanh - --- | Return the ceiling of x as a float64. --- DIVERGENCE FROM HASKELL: returns Double rather than Integer so that NaN and --- ±Inf inputs propagate per IEEE 754. -ceiling :: TypedTerm Double -> TypedTerm Double -ceiling = primitive1 DefMath.ceiling - --- | Return the cosine of x radians. -cos :: TypedTerm Double -> TypedTerm Double -cos = primitive1 DefMath.cos - --- | Return the hyperbolic cosine of x. -cosh :: TypedTerm Double -> TypedTerm Double -cosh = primitive1 DefMath.cosh - --- | Euler's number (e = 2.71828). -e :: TypedTerm Double -e = primitive DefMath.e - --- | Check if an integer is even. -even :: Integral a => TypedTerm a -> TypedTerm Bool -even = primitive1 DefMath.even - --- | Return e raised to the power x. -exp :: TypedTerm Double -> TypedTerm Double -exp = primitive1 DefMath.exp - --- | Return the floor of x as a float64. --- DIVERGENCE FROM HASKELL: returns Double rather than Integer so that NaN and --- ±Inf inputs propagate per IEEE 754. -floor :: TypedTerm Double -> TypedTerm Double -floor = primitive1 DefMath.floor - --- | Return the natural logarithm of x. -log :: TypedTerm Double -> TypedTerm Double -log = primitive1 DefMath.log - --- | Return the logarithm of x to the given base. -logBase :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -logBase = primitive2 DefMath.logBase - --- | Return the maximum of two values. -max :: Ord a => TypedTerm a -> TypedTerm a -> TypedTerm a -max = primitive2 DefMath.max - --- | Divide two integers using integer division, returning Nothing on division by zero. -maybeDiv :: TypedTerm Int -> TypedTerm Int -> TypedTerm (Maybe Int) -maybeDiv = primitive2 DefMath.maybeDiv - --- | Mathematical modulo, returning Nothing on division by zero. -maybeMod :: TypedTerm Int -> TypedTerm Int -> TypedTerm (Maybe Int) -maybeMod = primitive2 DefMath.maybeMod - --- | Return the predecessor (x - 1), returning Nothing on minBound. -maybePred :: TypedTerm Int -> TypedTerm (Maybe Int) -maybePred = primitive1 DefMath.maybePred - --- | Integer remainder, returning Nothing on division by zero. -maybeRem :: TypedTerm Int -> TypedTerm Int -> TypedTerm (Maybe Int) -maybeRem = primitive2 DefMath.maybeRem - --- | Return the successor (x + 1), returning Nothing on maxBound. -maybeSucc :: TypedTerm Int -> TypedTerm (Maybe Int) -maybeSucc = primitive1 DefMath.maybeSucc - --- | Return the minimum of two values. -min :: Ord a => TypedTerm a -> TypedTerm a -> TypedTerm a -min = primitive2 DefMath.min - --- | Multiply two numbers. -mul :: Num a => TypedTerm a -> TypedTerm a -> TypedTerm a -mul = primitive2 DefMath.mul - --- | Multiply two Float64 numbers. -mulFloat64 :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -mulFloat64 = primitive2 DefMath.mulFloat64 - --- | Negate a number. -negate :: Num a => TypedTerm a -> TypedTerm a -negate = primitive1 DefMath.negate - --- | Negate a Float64 number. -negateFloat64 :: TypedTerm Double -> TypedTerm Double -negateFloat64 = primitive1 DefMath.negateFloat64 - --- | Check if an integer is odd. -odd :: Integral a => TypedTerm a -> TypedTerm Bool -odd = primitive1 DefMath.odd - --- | Pi (pi = 3.14159). -pi :: TypedTerm Double -pi = primitive DefMath.pi - --- | Return x raised to the power y. -pow :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -pow = primitive2 DefMath.pow - --- | Generate a range of values from start to end (inclusive). -range :: Enum a => TypedTerm a -> TypedTerm a -> TypedTerm [a] -range start end = primitive2 DefMath.range start end - --- | Return x rounded to the nearest integer, as a float64. --- DIVERGENCE FROM HASKELL: returns Double rather than Integer so that NaN and --- ±Inf inputs propagate per IEEE 754. -round :: TypedTerm Double -> TypedTerm Double -round = primitive1 DefMath.round - --- | Round a float32 to n significant digits. -roundFloat32 :: TypedTerm Int -> TypedTerm Float -> TypedTerm Float -roundFloat32 = primitive2 DefMath.roundFloat32 - --- | Round a float64 to n significant digits. -roundFloat64 :: TypedTerm Int -> TypedTerm Double -> TypedTerm Double -roundFloat64 = primitive2 DefMath.roundFloat64 - --- | Return the sign of a number (-1, 0, or 1). -signum :: Num a => TypedTerm a -> TypedTerm a -signum = primitive1 DefMath.signum - --- | Return the sine of x radians. -sin :: TypedTerm Double -> TypedTerm Double -sin = primitive1 DefMath.sin - --- | Return the hyperbolic sine of x. -sinh :: TypedTerm Double -> TypedTerm Double -sinh = primitive1 DefMath.sinh - --- | Return the square root of x. -sqrt :: TypedTerm Double -> TypedTerm Double -sqrt = primitive1 DefMath.sqrt - --- | Subtract two numbers. -sub :: Num a => TypedTerm a -> TypedTerm a -> TypedTerm a -sub = primitive2 DefMath.sub - --- | Subtract two Float64 numbers. -subFloat64 :: TypedTerm Double -> TypedTerm Double -> TypedTerm Double -subFloat64 = primitive2 DefMath.subFloat64 - --- | Return the tangent of x radians. -tan :: TypedTerm Double -> TypedTerm Double -tan = primitive1 DefMath.tan - --- | Return the hyperbolic tangent of x. -tanh :: TypedTerm Double -> TypedTerm Double -tanh = primitive1 DefMath.tanh - --- | Return x truncated (towards zero), as a float64. --- DIVERGENCE FROM HASKELL: returns Double rather than Integer so that NaN and --- ±Inf inputs propagate per IEEE 754. -truncate :: TypedTerm Double -> TypedTerm Double -truncate = primitive1 DefMath.truncate diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Optionals.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Optionals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Optionals.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Phantom-typed term DSL for the hydra.lib.optionals library - -module Hydra.Dsl.Meta.Lib.Optionals where - -import Hydra.Typed -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Optionals as DefOptionals - - --- | Apply a function to an argument (applicative). -apply :: TypedTerm (Maybe (a -> b)) -> TypedTerm (Maybe a) -> TypedTerm (Maybe b) -apply = primitive2 DefOptionals.apply - --- | Chain operations on optional values, handling absent cases automatically. -bind :: TypedTerm (Maybe a) -> TypedTerm (a -> Maybe b) -> TypedTerm (Maybe b) -bind = primitive2 DefOptionals.bind - --- | Handle an optional value with the optional value as the first argument. --- The default and function arguments accept anything coercible to a term (AsTerm), --- mirroring the ergonomics of the former 'maybe' eliminator. -cases :: (AsTerm t1 b, AsTerm t2 (a -> b)) => TypedTerm (Maybe a) -> t1 -> t2 -> TypedTerm b -cases m def f = primitive3 DefOptionals.cases m (asTerm def) (asTerm f) - --- | Filter out absent values from a list. -cat :: TypedTerm [Maybe a] -> TypedTerm [a] -cat = primitive1 DefOptionals.cat - --- | Compose two optional-returning functions (Kleisli composition). -compose :: TypedTerm (a -> Maybe b) -> TypedTerm (b -> Maybe c) -> TypedTerm (a -> Maybe c) -compose = primitive2 DefOptionals.compose - --- | Get a value from an optional value, or return a default value. -fromOptional :: TypedTerm a -> TypedTerm (Maybe a) -> TypedTerm a -fromOptional = primitive2 DefOptionals.fromOptional - --- | Check if a value is present. -isGiven :: TypedTerm (Maybe a) -> TypedTerm Bool -isGiven = primitive1 DefOptionals.isGiven - --- | Check if a value is absent. -isNone :: TypedTerm (Maybe a) -> TypedTerm Bool -isNone = primitive1 DefOptionals.isNone - --- | Map a function over an optional value. -map :: AsTerm f (a -> b) => f -> TypedTerm (Maybe a) -> TypedTerm (Maybe b) -map f = primitive2 DefOptionals.map (asTerm f) - --- | Map a function over a list and collect present results. -mapOptional :: TypedTerm (a -> Maybe b) -> TypedTerm [a] -> TypedTerm [b] -mapOptional = primitive2 DefOptionals.mapOptional - --- | Lift a value into the optional type. -pure :: TypedTerm a -> TypedTerm (Maybe a) -pure = primitive1 DefOptionals.pure - --- | Convert an optional value to a list: a present value becomes [x], an absent value becomes []. -toList :: TypedTerm (Maybe a) -> TypedTerm [a] -toList = primitive1 DefOptionals.toList diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Pairs.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Pairs.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Pairs.hs +++ /dev/null @@ -1,22 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.pairs library - -module Hydra.Dsl.Meta.Lib.Pairs where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Pairs as DefPairs - - --- | Map over both elements of a pair. -bimap :: TypedTerm (a -> c) -> TypedTerm (b -> d) -> TypedTerm (a, b) -> TypedTerm (c, d) -bimap = primitive3 DefPairs.bimap - --- | Get the first element of a pair. -first :: TypedTerm (a, b) -> TypedTerm a -first = primitive1 DefPairs.first - --- | Get the second element of a pair. -second :: TypedTerm (a, b) -> TypedTerm b -second = primitive1 DefPairs.second diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Regex.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Regex.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Regex.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.regex library - -module Hydra.Dsl.Meta.Lib.Regex where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Regex as DefRegex - - --- | Find the first substring matching a regex pattern. -find :: TypedTerm String -> TypedTerm String -> TypedTerm (Maybe String) -find = primitive2 DefRegex.find - --- | Find all non-overlapping substrings matching a regex pattern. -findAll :: TypedTerm String -> TypedTerm String -> TypedTerm [String] -findAll = primitive2 DefRegex.findAll - --- | Check whether an entire string matches a regex pattern. -matches :: TypedTerm String -> TypedTerm String -> TypedTerm Bool -matches = primitive2 DefRegex.matches - --- | Replace the first occurrence of a regex pattern with a replacement string. -replace :: TypedTerm String -> TypedTerm String -> TypedTerm String -> TypedTerm String -replace = primitive3 DefRegex.replace - --- | Replace all non-overlapping occurrences of a regex pattern with a replacement string. -replaceAll :: TypedTerm String -> TypedTerm String -> TypedTerm String -> TypedTerm String -replaceAll = primitive3 DefRegex.replaceAll - --- | Split a string by a regex pattern. -split :: TypedTerm String -> TypedTerm String -> TypedTerm [String] -split = primitive2 DefRegex.split diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Sets.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Sets.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Sets.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Phantom-typed term DSL for the hydra.lib.sets library - -module Hydra.Dsl.Meta.Lib.Sets where - -import Hydra.Typed -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms - -import Data.Set -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Sets as DefSets - - --- | Delete an element from a set. -delete :: AsTerm t a => t -> TypedTerm (Set a) -> TypedTerm (Set a) -delete x = primitive2 DefSets.delete (asTerm x) - --- | Compute the difference of two sets. -difference :: TypedTerm (Set a) -> TypedTerm (Set a) -> TypedTerm (Set a) -difference = primitive2 DefSets.difference - --- | Create an empty set. -empty :: TypedTerm (Set a) -empty = primitive DefSets.empty - --- | Create a set from a list. -fromList :: AsTerm t [a] => t -> TypedTerm (Set a) -fromList xs = primitive1 DefSets.fromList (asTerm xs) - --- | Insert an element into a set. -insert :: TypedTerm a -> TypedTerm (Set a) -> TypedTerm (Set a) -insert = primitive2 DefSets.insert - --- | Compute the intersection of two sets. -intersection :: TypedTerm (Set a) -> TypedTerm (Set a) -> TypedTerm (Set a) -intersection = primitive2 DefSets.intersection - --- | Map a function over a set. -map :: TypedTerm (a -> b) -> TypedTerm (Set a) -> TypedTerm (Set b) -map = primitive2 DefSets.map - --- | Check if an element is in a set. -member :: TypedTerm a -> TypedTerm (Set a) -> TypedTerm Bool -member = primitive2 DefSets.member - --- | Check if a set is empty. -null :: TypedTerm (Set a) -> TypedTerm Bool -null = primitive1 DefSets.null - --- | Create a singleton set. -singleton :: TypedTerm a -> TypedTerm (Set a) -singleton = primitive1 DefSets.singleton - --- | Get the size of a set. -size :: TypedTerm (Set a) -> TypedTerm Int -size = primitive1 DefSets.size - --- | Convert a set to a list. -toList :: TypedTerm (Set a) -> TypedTerm [a] -toList = primitive1 DefSets.toList - --- | Compute the union of two sets. -union :: TypedTerm (Set a) -> TypedTerm (Set a) -> TypedTerm (Set a) -union = primitive2 DefSets.union - --- | Compute the union of multiple sets. -unions :: TypedTerm [Set a] -> TypedTerm (Set a) -unions = primitive1 DefSets.unions diff --git a/src/main/haskell/Hydra/Dsl/Meta/Lib/Strings.hs b/src/main/haskell/Hydra/Dsl/Meta/Lib/Strings.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Lib/Strings.hs +++ /dev/null @@ -1,68 +0,0 @@ --- | Phantom-typed term DSL for the hydra.lib.strings library - -module Hydra.Dsl.Meta.Lib.Strings where - -import Hydra.Typed -import Hydra.Dsl.Meta.Phantoms -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Strings as DefStrings - - --- | Concatenate a list of strings into a single string. -cat :: TypedTerm [String] -> TypedTerm String -cat = primitive1 DefStrings.cat - --- | Concatenate two strings. -cat2 :: TypedTerm String -> TypedTerm String -> TypedTerm String -cat2 = primitive2 DefStrings.cat2 - --- | Convert a list of Unicode code points to a string. -fromList :: TypedTerm [Int] -> TypedTerm String -fromList = primitive1 DefStrings.fromList - --- | Join a list of strings with a separator between each element. -intercalate :: TypedTerm String -> TypedTerm [String] -> TypedTerm String -intercalate = primitive2 DefStrings.intercalate - --- | Return the length of a string. -length :: TypedTerm String -> TypedTerm Int -length = primitive1 DefStrings.length - --- | Split a string into lines. -lines :: TypedTerm String -> TypedTerm [String] -lines = primitive1 DefStrings.lines - --- | Get the Unicode code point of the character at a specific index, returning Nothing if out of bounds. -maybeCharAt :: TypedTerm Int -> TypedTerm String -> TypedTerm (Maybe Int) -maybeCharAt = primitive2 DefStrings.maybeCharAt - --- | Check whether a string is empty. -null :: TypedTerm String -> TypedTerm Bool -null = primitive1 DefStrings.null - --- | Split a string on a delimiter string. -splitOn :: TypedTerm String -> TypedTerm String -> TypedTerm [String] -splitOn = primitive2 DefStrings.splitOn - --- | Convert a string to a list of Unicode code points. -toList :: TypedTerm String -> TypedTerm [Int] -toList = primitive1 DefStrings.toList - --- | Convert a string to lowercase. -toLower :: TypedTerm String -> TypedTerm String -toLower = primitive1 DefStrings.toLower - --- | Convert a string to uppercase. -toUpper :: TypedTerm String -> TypedTerm String -toUpper = primitive1 DefStrings.toUpper - --- | Join a list of strings with newlines, appending a trailing newline. -unlines :: TypedTerm [String] -> TypedTerm String -unlines = primitive1 DefStrings.unlines - --- Helpers - --- | Concatenate a Haskell list of string terms into a single string. -concat :: [TypedTerm String] -> TypedTerm String -concat strings = primitive DefStrings.cat @@ list strings diff --git a/src/main/haskell/Hydra/Dsl/Meta/Literals.hs b/src/main/haskell/Hydra/Dsl/Meta/Literals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Literals.hs +++ /dev/null @@ -1,80 +0,0 @@ --- | A DSL for constructing literal terms using Haskell's built-in datatypes - -module Hydra.Dsl.Meta.Literals where - -import Hydra.Typed -import qualified Hydra.Dsl.Terms as Terms - -import Data.Int -import qualified Data.ByteString as B -import qualified Data.Scientific as Sci - - --- Binary is now properly represented as ByteString -type Binary = B.ByteString - -bigint :: Integer -> TypedTerm Integer -bigint = TypedTerm . Terms.bigint - -binary :: Binary -> TypedTerm Binary -binary = TypedTerm . Terms.binary - -bool :: Bool -> TypedTerm Bool -bool = TypedTerm . Terms.boolean - -boolean :: Bool -> TypedTerm Bool -boolean = bool - -char :: Char -> TypedTerm Int -char = TypedTerm . Terms.char - -decimal :: Sci.Scientific -> TypedTerm Sci.Scientific -decimal = TypedTerm . Terms.decimal - -double :: Double -> TypedTerm Double -double = float64 - -false :: TypedTerm Bool -false = bool False - -float :: Float -> TypedTerm Float -float = float32 - -float32 :: Float -> TypedTerm Float -float32 = TypedTerm . Terms.float32 - -float64 :: Double -> TypedTerm Double -float64 = TypedTerm . Terms.float64 - -int :: Int -> TypedTerm Int -int = int32 - -int16 :: Int16 -> TypedTerm Int16 -int16 = TypedTerm . Terms.int16 - -int32 :: Int -> TypedTerm Int -int32 = TypedTerm . Terms.int32 - -int64 :: Int64 -> TypedTerm Int64 -int64 = TypedTerm . Terms.int64 - -int8 :: Int8 -> TypedTerm Int8 -int8 = TypedTerm . Terms.int8 - -string :: String -> TypedTerm String -string = TypedTerm . Terms.string - -true :: TypedTerm Bool -true = bool True - -uint16 :: Int -> TypedTerm Int -uint16 = TypedTerm . Terms.uint16 - -uint32 :: Int64 -> TypedTerm Int64 -uint32 = TypedTerm . Terms.uint32 - -uint64 :: Integer -> TypedTerm Integer -uint64 = TypedTerm . Terms.uint64 - -uint8 :: Int16 -> TypedTerm Int16 -uint8 = TypedTerm . Terms.uint8 diff --git a/src/main/haskell/Hydra/Dsl/Meta/Phantoms.hs b/src/main/haskell/Hydra/Dsl/Meta/Phantoms.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Phantoms.hs +++ /dev/null @@ -1,487 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Term-level DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions. --- The phantom types provide static type checking in Haskell prior to Hydra's runtime type checking. -module Hydra.Dsl.Meta.Phantoms ( - module Hydra.Dsl.Meta.Phantoms, - module Hydra.Dsl.Meta.Literals, - module Hydra.Dsl.AsTerm, -) where - -import Hydra.Kernel -import Hydra.Dsl.AsTerm -import Hydra.Dsl.Meta.Common -import Hydra.Dsl.Meta.Literals -import qualified Hydra.Dsl.Annotations as Ann -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Show.Core as ShowCore -import Hydra.Encoding (encodeBindingName) -import Hydra.Decoding (decodeBindingName) - -import Prelude hiding ((++)) -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Hydra.Dsl.Prims as Prims -import qualified Hydra.Lib.Eithers as DefEithers -import qualified Hydra.Lib.Lists as DefLists -import qualified Hydra.Lib.Math as DefMath -import qualified Hydra.Lib.Optionals as DefOptionals -import qualified Hydra.Lib.Strings as DefStrings - - --- Operators - -infixr 0 ~> -(~>) :: String -> TypedTerm x -> TypedTerm (a -> b) -name ~> body = lambda name body - -infixl 1 <~ -(<~) :: String -> TypedTerm a -> TypedTerm b -> TypedTerm b -name <~ value = let1 name value - -infixl 1 <<~ -(<<~) :: AsTerm t (Either e a) => String -> t -> TypedTerm (Either e b) -> TypedTerm (Either e b) -name <<~ def = eitherBind name (asTerm def) - --- | Function composition operator: f <.> g creates a function that applies g then f --- Example: toString <.> increment --- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) -(<.>) :: (AsTerm f (b -> c), AsTerm g (a -> b)) => f -> g -> TypedTerm (a -> c) -f <.> g = compose (asTerm f) (asTerm g) - --- | Function application operator: function @@ argument --- Example: add @@ int32 1 --- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) -(@@) :: (AsTerm f (a -> b), AsTerm g a) => f -> g -> TypedTerm b -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) - --- | Field definition operator for records: name>: value --- Example: "name">: string "John" --- Accepts TypedTerm or TypedBinding (via AsTerm) -infixr 0 >: -(>:) :: AsTerm t a => String -> t -> Field -name>: term = Field (Name name) (unTypedTerm $ asTerm term) - --- | Field definition operator with pre-constructed name: fname>>: value --- Example: _Person_name>>: string "John" --- Accepts TypedTerm or TypedBinding (via AsTerm) -infixr 0 >>: -(>>:) :: AsTerm t a => Name -> t -> Field -fname >>: d = field fname (asTerm d) - --- | Add an annotation to a term --- Example: annot (Name "deprecated") (Just (boolean True)) myFunction -annot :: Name -> Maybe Term -> TypedTerm a -> TypedTerm a -annot key mvalue (TypedTerm term) = TypedTerm $ Ann.annotateTerm key mvalue term - --- | Apply a function to an argument --- Example: apply (var "add") (int32 1) -apply :: TypedTerm (a -> b) -> TypedTerm a -> TypedTerm b -apply (TypedTerm lhs) (TypedTerm rhs) = TypedTerm $ Terms.apply lhs rhs - - - --- | Apply a named case match to an argument --- Example: cases resultTypeName myResult Nothing [onSuccess, onError] --- See also: 'match' -cases :: Name -> TypedTerm a -> Maybe (TypedTerm b) -> [Field] -> TypedTerm b -cases name arg dflt fields = TypedTerm $ Terms.apply (Terms.match name (unTypedTerm <$> dflt) fields) (unTypedTerm arg) - --- | Compose two functions (g then f) --- Example: compose (var "stringLength") (var "toString") --- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) -compose :: (AsTerm f (b -> c), AsTerm g (a -> b)) => f -> g -> TypedTerm (a -> c) -compose f g = TypedTerm $ Terms.compose (unTypedTerm $ asTerm f) (unTypedTerm $ asTerm g) - --- | Create a constant function that always returns the same value --- Example: constant true --- Accepts TypedTerm or TypedBinding (via AsTerm) -constant :: AsTerm t a => t -> TypedTerm (b -> a) -constant t = TypedTerm $ Terms.constant (unTypedTerm $ asTerm t) - --- | Get a reference to a decoder function in hydra.decode.core for a given type name --- The decoder takes a graph context and a term, returning either a decoding error or the decoded value -decoderFor :: Name -> TypedTerm (Graph -> Term -> Prelude.Either DecodingError a) -decoderFor typeName = var $ unName $ decodeBindingName typeName - --- | Create a definition in a module --- Example: definitionInModule myModule "addInts" (lambda "x" (lambda "y" (add @@ var "x" @@ var "y"))) -definitionInModule :: Module -> String -> TypedTerm a -> TypedTermDefinition a -definitionInModule mod = definitionInModuleName $ moduleName mod - --- | Create a definition in a namespace --- Example: definitionInModuleName (ModuleName "com.example") "addInts" myFunction -definitionInModuleName :: ModuleName -> String -> TypedTerm a -> TypedTermDefinition a -definitionInModuleName ns lname = TypedTermDefinition $ unqualifyName $ QualifiedName (Just ns) lname - --- | Add documentation to a term --- Example: doc "Adds two integers" addFunction --- Accepts TypedTerm or TypedBinding (via AsTerm) -doc :: AsTerm t a => String -> t -> TypedTerm a -doc s t = TypedTerm $ setTermDescription (Just s) (unTypedTerm $ asTerm t) - --- | Add documentation with line wrapping at the specified width --- Example: docWrapped 80 "This is a long documentation string that will be wrapped..." myFunction -docWrapped :: Int -> String -> TypedTerm a -> TypedTerm a -docWrapped len = doc . wrapLine len - --- | Bind over Either: extracts the Right value into a variable, short-circuiting on Left -eitherBind :: AsTerm t (Either e a) => String -> t -> TypedTerm (Either e b) -> TypedTerm (Either e b) -eitherBind v def body = primitive2 (Prims.primName DefEithers.bind) (asTerm def) $ lambda v $ body - --- | Convert a typed element to an untyped element (legacy name, prefer 'toBinding') --- Example: el (definitionInModule myModule "addInts" myFunction) -el :: TypedBinding a -> Binding -el = toBinding - -encodedBinary :: TypedTerm String -> TypedTerm Term -encodedBinary = encodedLiteral . inject _Literal _Literal_binary - -encodedBoolean :: TypedTerm Bool -> TypedTerm Term -encodedBoolean = encodedLiteral . inject _Literal _Literal_boolean - -encodedCase :: AsTerm t (a -> Term) => Name -> Name -> t -> Field -encodedCase tname fname enc = field fname $ "v" ~> encodedVariant tname fname (enc @@ var "v") - -encodedEither :: TypedTerm (Prelude.Either a b) -> TypedTerm Term -encodedEither = inject _Term _Term_either - -encodedField :: Name -> TypedTerm Term -> TypedTerm Term -encodedField fname term = encodedFieldRaw (encodedName fname) term - -encodedFieldRaw :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term -encodedFieldRaw (TypedTerm fname) (TypedTerm term) = TypedTerm $ Terms.record _Field [ - Field _Field_name fname, - Field _Field_term term] - -encodedFloatValue :: TypedTerm FloatValue -> TypedTerm Term -encodedFloatValue = encodedLiteral . inject _Literal _Literal_float - -encodedInjection :: Name -> Name -> TypedTerm Term -> TypedTerm Term -encodedInjection tname fname term = TypedTerm $ Terms.record _Injection [ - field _Injection_typeName $ encodedName tname, - field _Injection_field $ encodedField fname term] - -encodedInt32 :: TypedTerm Int -> TypedTerm Term -encodedInt32 v = encodedIntegerValue $ inject _IntegerValue _IntegerValue_int32 v - -encodedIntegerValue :: TypedTerm IntegerValue -> TypedTerm Term -encodedIntegerValue = encodedLiteral . inject _Literal _Literal_integer - -encodedList :: TypedTerm [a] -> TypedTerm Term -encodedList = inject _Term _Term_list - -encodedLiteral :: TypedTerm Literal -> TypedTerm Term -encodedLiteral = inject _Term _Term_literal - -encodedMap :: TypedTerm (M.Map k v) -> TypedTerm Term -encodedMap = inject _Term _Term_map - -encodedName :: Name -> TypedTerm Name -encodedName = wrap _Name . string . unName - -encodedOptional :: TypedTerm (Maybe a) -> TypedTerm Term -encodedOptional = inject _Term _Term_optional - -encodedPair :: TypedTerm (a, b) -> TypedTerm Term -encodedPair = inject _Term _Term_pair - -encodedRecord :: Name -> [Field] -> TypedTerm Term -encodedRecord tname fields = TypedTerm $ Terms.inject _Term _Term_record $ Terms.record _Record [ - field _Record_typeName $ encodedName tname, - field _Record_fields $ list (encField <$> fields)] - where - encField (Field fname term) = encodedField fname $ TypedTerm term - -encodedSet :: TypedTerm (S.Set a) -> TypedTerm Term -encodedSet = inject _Term _Term_set - -encodedString :: TypedTerm String -> TypedTerm Term -encodedString = encodedLiteral . inject _Literal _Literal_string - -encodedUnion :: TypedTerm Term -> TypedTerm Term -encodedUnion = inject _Term _Term_inject - -encodedUnit :: TypedTerm Term -encodedUnit = injectUnit _Term _Term_unit - -encodedVariant :: Name -> Name -> TypedTerm Term -> TypedTerm Term -encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term - -encodedWrappedTerm :: Name -> TypedTerm Term -> TypedTerm Term -encodedWrappedTerm name = encodedWrappedTermRaw (encodedName name) - -encodedWrappedTermRaw :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term -encodedWrappedTermRaw (TypedTerm name) (TypedTerm term) = TypedTerm $ Terms.inject _Term _Term_wrap $ Terms.record _WrappedTerm [ - Field _WrappedTerm_typeName name, - Field _WrappedTerm_body term] - --- | Get a reference to an encoder function in hydra.encode.core for a given type name -encoderFor :: Name -> TypedTerm (a -> Term) -encoderFor typeName = var $ unName $ encodeBindingName typeName - --- | Create a field with the given name and value --- Example: field (Name "age") (int32 30) -field :: Name -> TypedTerm a -> Field -field fname (TypedTerm val) = Field fname val - --- | Mark a type as first-class --- Example: firstClassType (record ...) -firstClassType :: TypedTerm Type -> TypedTerm Type -firstClassType typ = annot keyFirstClassType (Just $ Terms.boolean True) typ - --- | Create a fold function to process lists --- Example: fold (lambda "acc" (lambda "x" (add @@ var "acc" @@ var "x"))) -fold :: AsTerm t (b -> a -> b) => t -> TypedTerm (b -> [a] -> b) -fold f = (primitive (Prims.primName DefLists.foldl)) @@ asTerm f - --- | Identity function that returns its argument unchanged --- Example: identity -identity :: TypedTerm (a -> a) -identity = TypedTerm Terms.identity - --- | Create a union injection --- Example: inject (Name "Result") (Name "success") (string "ok") -inject :: (AsName t, AsName f) => t -> f -> TypedTerm a -> TypedTerm b -inject n fn (TypedTerm term) = TypedTerm $ Terms.inject (asName n) (asName fn) term - --- | Create a function that injects its argument into a union variant --- Example: injectLambda (Name "Result") (Name "success") -injectLambda :: Name -> Name -> TypedTerm (a -> b) -injectLambda name fname = lambda "injected_" $ inject name fname $ var "injected_" - --- | Create a unit variant of a union --- Example: injectUnit (Name "Result") (Name "success") -injectUnit :: (AsName t, AsName f) => t -> f -> TypedTerm a -injectUnit n fn = TypedTerm $ Terms.inject (asName n) (asName fn) Terms.unit - --- | Create a 'Just' optional value --- Example: just (string "found") --- Accepts TypedTerm or TypedBinding (via AsTerm) -just :: AsTerm t a => t -> TypedTerm (Maybe a) -just t = TypedTerm $ Terms.just (unTypedTerm $ asTerm t) - --- | Function that wraps a value in 'Just' --- Example: just_ @@ myValue -just_ :: TypedTerm (a -> Maybe a) -just_ = TypedTerm $ Terms.lambda "just_" $ Terms.just $ Terms.var "just_" - --- | Create a lambda function with one parameter --- Example: lambda "x" (var "add" @@ var "x" @@ int32 1) -lambda :: String -> TypedTerm x -> TypedTerm (a -> b) -lambda v (TypedTerm body) = TypedTerm $ Terms.lambda v body - --- | Create a multi-parameter lambda function --- Example: lambdas ["x", "y"] (add @@ var "x" @@ var "y") -lambdas :: [String] -> TypedTerm x -> TypedTerm (a -> b) -lambdas params (TypedTerm body) = TypedTerm $ Terms.lambdas params body - --- | Create a 'Left' either value --- Example: left (string "error") -left :: TypedTerm a -> TypedTerm (Either a b) -left (TypedTerm term) = TypedTerm $ Terms.left term - --- | Function that wraps a value in 'Left' --- Example: left_ @@ myValue -left_ :: TypedTerm (a -> Either a b) -left_ = TypedTerm $ Terms.lambda "left_" $ Terms.left $ Terms.var "left_" - -let1 :: String -> TypedTerm a -> TypedTerm b -> TypedTerm b -let1 name (TypedTerm value) (TypedTerm env) = TypedTerm $ TermLet $ Let [Binding (Name name) value Nothing] env - --- | Create a let expression with multiple bindings --- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y") -lets :: [Field] -> TypedTerm a -> TypedTerm a -lets fields (TypedTerm env) = TypedTerm $ TermLet $ Let (toBinding <$> fields) env - where - toBinding (Field name value) = Binding name value Nothing - --- | Create a list of terms --- Example: list [int32 1, int32 2, int32 3] --- Accepts TypedTerm or TypedBinding elements (via AsTerm) -list :: AsTerm t a => [t] -> TypedTerm [a] -list els = TypedTerm $ Terms.list (unTypedTerm . asTerm <$> els) - --- | Create a map/dictionary term --- Example: map (M.fromList [(string "a", int32 1), (string "b", int32 2)]) -map :: M.Map (TypedTerm a) (TypedTerm b) -> TypedTerm (M.Map a b) -map = TypedTerm . Terms.map . M.fromList . fmap fromTypedTerm . M.toList - where - fromTypedTerm (TypedTerm k, TypedTerm v) = (k, v) - --- | Create a pattern match on a union term --- Example: match (Name "Result") (Just $ string "what?") ["success">: string "yay", "error">: string "boo"] -match :: AsName n => n -> Maybe (TypedTerm b) -> [Field] -> TypedTerm (a -> b) -match n dflt fields = TypedTerm $ Terms.match (asName n) (unTypedTerm <$> dflt) fields - --- | Lift a Haskell Name value to a phantom-typed TypedTerm Name -nameLift :: Name -> TypedTerm Name -nameLift (Name n) = wrap _Name $ string n - --- | Create a 'Nothing' optional value --- Example: nothing -nothing :: TypedTerm (Maybe a) -nothing = TypedTerm Terms.nothing - --- | Create an optional value from a Maybe --- Example: opt (Just myValue) -opt :: Maybe (TypedTerm a) -> TypedTerm (Maybe a) -opt mc = TypedTerm $ Terms.optional (unTypedTerm <$> mc) - -optCases :: AsTerm f (a -> b) => TypedTerm (Maybe a) -> TypedTerm b -> f -> TypedTerm b -optCases arg ifNothing ifJust = primitive3 (Name "hydra.lib.optionals.cases") arg ifNothing (asTerm ifJust) - --- | Create a pair --- Example: pair (string "age") (int32 32) --- Accepts TypedTerm or TypedBinding (via AsTerm) -pair :: (AsTerm t1 a, AsTerm t2 b) => t1 -> t2 -> TypedTerm (a, b) -pair l r = TypedTerm $ Terms.pair (unTypedTerm $ asTerm l) (unTypedTerm $ asTerm r) - --- | Primitive function by name --- Example: primitive (Name "hydra.lib.strings.length") -primitive :: Terms.ToPrimName n => n -> TypedTerm a -primitive = TypedTerm . Terms.primitive - --- | Apply a primitive function to one argument --- Example: primitive1 DefMath.abs (int32 (-5)) -primitive1 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b -primitive1 n (TypedTerm a) = TypedTerm $ Terms.primitive n Terms.@@ a - --- | Apply a primitive function to two arguments --- Example: primitive2 DefMath.add (int32 2) (int32 3) -primitive2 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b -> TypedTerm c -primitive2 n (TypedTerm a) (TypedTerm b) = TypedTerm $ Terms.primitive n Terms.@@ a Terms.@@ b - --- | Apply a primitive function to three arguments --- Example: primitive3 DefStrings.replace (string "hello") (string "e") (string "a") -primitive3 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d -primitive3 n (TypedTerm a) (TypedTerm b) (TypedTerm c) = TypedTerm $ Terms.primitive n Terms.@@ a Terms.@@ b Terms.@@ c - --- | Extract a field from a record --- Example: project (Name "Person") (Name "name") -project :: (AsName t, AsName f) => t -> f -> TypedTerm (a -> b) -project n fn = TypedTerm $ Terms.project (asName n) (asName fn) - --- | Create a record with named fields --- Example: record (Name "Person") [field (Name "name") (string "John"), field (Name "age") (int32 30)] -record :: AsName n => n -> [Field] -> TypedTerm a -record n fields = TypedTerm $ Terms.record (asName n) fields - --- | Reify a Haskell-level meta-function over phantom-typed terms into a first-class --- term-level function. See also 'reify2' for the binary form. --- Example: @reify Literals.showInt32@ has type @TypedTerm (Int -> String)@ -reify :: (TypedTerm a -> TypedTerm b) -> TypedTerm (a -> b) -reify f = case (unTypedTerm $ f $ var "x") of - TermApplication (Application lhs _) -> TypedTerm lhs - TermEither (Prelude.Left _) -> lambda "x" $ TypedTerm $ TermEither $ Prelude.Left $ Terms.var "x" - TermEither (Prelude.Right _) -> lambda "x" $ TypedTerm $ TermEither $ Prelude.Right $ Terms.var "x" - TermOptional (Just _) -> primitive (Prims.primName DefOptionals.pure) - TermInject (Injection tname (Field fname _)) -> lambda "x" $ inject tname fname $ var "x" - TermWrap (WrappedTerm tname _) -> lambda "x" $ wrap tname $ var "x" - --- | Reify a binary Haskell-level meta-function over phantom-typed terms into a --- first-class term-level function. See also 'reify' for the unary form. --- Example: @reify2 (\\x y -> Maths.add x (Maths.mul x y))@ -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 - - - --- | Create a 'Right' either value --- Example: right (int32 42) -right :: TypedTerm b -> TypedTerm (Either a b) -right (TypedTerm term) = TypedTerm $ Terms.right term - --- | Function that wraps a value in 'Right' --- Example: right_ @@ myValue -right_ :: TypedTerm (b -> Either a b) -right_ = TypedTerm $ Terms.lambda "right_" $ Terms.right $ Terms.var "right_" - --- | Create a set of terms --- Example: set [string "a", string "b", string "c"] -set :: [TypedTerm a] -> TypedTerm (S.Set a) -set = TypedTerm . Terms.set . S.fromList . fmap unTypedTerm - --- | Convert a typed binding to an untyped Binding for use in module element lists --- Example: toBinding functionArity -toBinding :: TypedBinding a -> Binding -toBinding (TypedBinding name (TypedTerm term)) = Binding name term Nothing - --- | Convert a phantom-typed term definition to a Definition for use in module definition lists --- Example: toDefinition functionArity -toDefinition :: TypedTermDefinition a -> Definition -toDefinition (TypedTermDefinition name (TypedTerm term)) = DefinitionTerm $ TermDefinition name Nothing Nothing term - --- | Convert a phantom-typed term definition to a primitive Definition, using the term body as the --- declarative default implementation. The TermSignature describes the primitive's logical type. --- isPure / isTotal default to True; use withImpurity / withPartiality to flag exceptions. --- The 'comments' argument (second-to-last) is a list of long-form prose notes elaborating the one-line --- description, one element per logical observation (e.g. semantics, edge cases, totality, host correspondence); --- the default-implementation argument stays last because its value is typically large. --- Example: toPrimitive "logical AND" andSig [] and_ -toPrimitive :: String -> TermSignature -> [String] -> TypedTermDefinition a -> Definition -toPrimitive description sig comments (TypedTermDefinition name (TypedTerm term)) = - DefinitionPrimitive $ PrimitiveDefinition name (primitiveMetadata description comments) sig True True (Just term) - --- | Convert a Name to a primitive Definition with no default implementation. Used for primitives --- whose meaning is host-native and not expressible as a Hydra term (e.g. currentUnixTimeSeconds). --- The trailing 'comments' argument is a list of long-form prose notes, one element per logical observation. --- Example: toPrimitiveNoDefault "Current UNIX time, in seconds" sig (Name "hydra.lib.math.currentUnixTimeSeconds") [] -toPrimitiveNoDefault :: String -> TermSignature -> Name -> [String] -> Definition -toPrimitiveNoDefault description sig name comments = - DefinitionPrimitive $ PrimitiveDefinition name (primitiveMetadata description comments) sig True True Nothing - --- | Build the entity metadata for a primitive from its (always-present) one-line description and --- long-form comments. Folds the former PrimitiveDefinition.description/comments fields into --- EntityMetadata without data loss: description -> metadata.description, comments -> metadata.comments. --- Each comments element is one logical observation, kept distinct rather than concatenated. -primitiveMetadata :: String -> [String] -> Maybe EntityMetadata -primitiveMetadata description comments = - Just (EntityMetadata (Just description) comments [] Nothing) - - - --- | Convert a typed binding to a term Definition for use in module definition lists --- Example: toTermDefinition functionArity -toTermDefinition :: TypedBinding a -> Definition -toTermDefinition (TypedBinding name (TypedTerm term)) = DefinitionTerm $ TermDefinition name Nothing Nothing term - - -triple :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm (a, b, c) -triple (TypedTerm a) (TypedTerm b) (TypedTerm c) = TypedTerm $ Terms.triple a b c - -tuple4 :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d -> TypedTerm (a, b, c, d) -tuple4 (TypedTerm a) (TypedTerm b) (TypedTerm c) (TypedTerm d) = TypedTerm $ Terms.tuple4 a b c d - -tuple5 :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d -> TypedTerm e -> TypedTerm (a, b, c, d, e) -tuple5 (TypedTerm a) (TypedTerm b) (TypedTerm c) (TypedTerm d) (TypedTerm e) = TypedTerm $ Terms.tuple5 a b c d e - --- | Unit value (empty record) -unit :: TypedTerm a -unit = TypedTerm Terms.unit - --- | Unsafe phantom type cast. Used during bootstrap when changing Module field types. -unsafeCast :: TypedTerm a -> TypedTerm b -unsafeCast (TypedTerm t) = TypedTerm t - --- | Create an unwrap function for a wrapped type --- Example: unwrap (Name "Email") -unwrap :: AsName n => n -> TypedTerm (a -> b) -unwrap = TypedTerm . Terms.unwrap . asName - --- | Create a variable reference --- Example: var "x" -var :: String -> TypedTerm a -var v = TypedTerm $ Terms.var v - --- | Create a wrapped term (instance of a newtype) --- Example: wrap (Name "Email") (string "user@example.com") --- Note: the phantom types provide no guarantee of type safety in this case -wrap :: AsName n => n -> TypedTerm a -> TypedTerm b -wrap n (TypedTerm term) = TypedTerm $ Terms.wrap (asName n) term diff --git a/src/main/haskell/Hydra/Dsl/Meta/Tabular.hs b/src/main/haskell/Hydra/Dsl/Meta/Tabular.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Tabular.hs +++ /dev/null @@ -1,14 +0,0 @@ --- | DSL helpers for constructing tabular (relational) schemas - -module Hydra.Dsl.Meta.Tabular where - -import Hydra.Core -import Hydra.Relational -import Hydra.Tabular - - -columnType :: String -> Type -> ColumnType -columnType name typ = ColumnType (ColumnName name) typ - -tableType :: String -> [ColumnType] -> TableType -tableType name columns = TableType (RelationName name) columns diff --git a/src/main/haskell/Hydra/Dsl/Meta/Terms.hs b/src/main/haskell/Hydra/Dsl/Meta/Terms.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Terms.hs +++ /dev/null @@ -1,528 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | A domain-specific language for constructing term-encoded Hydra terms in Haskell; --- these functions enable you to build terms (programs) which build terms. -module Hydra.Dsl.Meta.Terms ( - module Hydra.Dsl.Meta.Base, - module Hydra.Dsl.Meta.Terms, -) where - -import Hydra.Kernel -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Meta.Core as Core -import qualified Hydra.Encode.Core as EncodeCore -import Hydra.Dsl.Meta.Base -import qualified Hydra.Dsl.Meta.Phantoms as Phantoms -import qualified Hydra.Dsl.Meta.Lib.Maps as Maps - -import qualified Data.ByteString as B -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Scientific as Sci -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Data.Int -import Prelude hiding (map, product, sum) - - --- Operators - --- | Function composition operator for term-encoded terms: f <.> g creates a function that applies g then f --- Example: var "stringLength" <.> var "toString" -(<.>) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -f <.> g = compose f g - --- | Function application operator for term-encoded terms --- Example: fun @@ arg -(@@) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -f @@ x = apply f x - --- | Attach a map of annotations to a term-encoded term, wrapping the map as a --- TermMap annotation per Hydra's convention (#386). Each Name key is lifted --- to a TermVariable in the resulting TermMap. --- Distinct from 'Phantoms.annot' (which attaches a single annotation by key). --- Example: annots (Phantoms.map M.empty) (int32 42) -annots :: TypedTerm (M.Map Name Term) -> TypedTerm Term -> TypedTerm Term -annots annMap term = Core.termAnnotated $ Core.annotatedTerm term (annotationMapToTerm annMap) - --- | Create a term-encoded annotated term (term with type annotations). --- The map argument is wrapped as a TermMap annotation per Hydra's convention. --- Example: annotated (int32 42) (Phantoms.map M.empty) -annotated :: TypedTerm Term -> TypedTerm (M.Map Name Term) -> TypedTerm Term -annotated term annMap = Core.termAnnotated $ Core.annotatedTerm term (annotationMapToTerm annMap) - --- | Lift a term-encoded Map to a term-encoded TermMap with each --- Name key wrapped as a TermVariable. The canonical encoding for Hydra's --- annotation map convention after #386. -annotationMapToTerm :: TypedTerm (M.Map Name Term) -> TypedTerm Term -annotationMapToTerm m = Core.termMap - (Maps.mapKeys (Phantoms.lambda "n" (Core.termVariable (Phantoms.var "n"))) m) - -annotatedTerm :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -annotatedTerm body ann = inject (Core.nameLift _Term) "annotated" $ record (Core.nameLift _AnnotatedTerm) [ - _AnnotatedTerm_body>>: body, - _AnnotatedTerm_annotation>>: ann] - --- | Apply a term-encoded function to a term-encoded argument --- Example: apply (var "add") (int32 1) -apply :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -apply func arg = Core.termApplication $ Core.application func arg - --- | Create a term-encoded unlimited precision integer --- Example: bigint 42 -bigint :: Integer -> TypedTerm Term -bigint = bigintLift . TypedTerm . Terms.bigint - --- | Lift a TypedTerm Integer to a term-encoded bigint literal --- Example: bigintLift (varPhantom "x" :: TypedTerm Integer) -bigintLift :: TypedTerm Integer -> TypedTerm Term -bigintLift = Core.termLiteral . Core.literalInteger . Core.integerValueBigint - --- | Create a term-encoded binary (byte string) literal --- Example: binary (B.pack [0x48, 0x65, 0x6C, 0x6C, 0x6F]) -binary :: B.ByteString -> TypedTerm Term -binary = binaryLift . TypedTerm . Terms.binary - --- | Lift a TypedTerm ByteString to a term-encoded binary literal -binaryLift :: TypedTerm B.ByteString -> TypedTerm Term -binaryLift = Core.termLiteral . Core.literalBinary - --- | Create a term-encoded boolean literal --- Example: boolean True -boolean :: Bool -> TypedTerm Term -boolean = booleanLift . TypedTerm . Terms.boolean - --- | Lift a TypedTerm Bool to a term-encoded boolean literal --- Example: booleanLift $ Phantoms.true -booleanLift :: TypedTerm Bool -> TypedTerm Term -booleanLift = Core.termLiteral . Core.literalBoolean - --- | Create a meta-level term encoding a boolean literal --- Example: booleanTerm True creates a term that *represents* the boolean True -booleanTerm :: Bool -> TypedTerm Term -booleanTerm b = inject (Core.nameLift _Term) "literal" $ inject (Core.nameLift _Literal) "boolean" $ boolean b - --- | Create a term-encoded character literal via int32 --- Example: char 'A' -char :: Char -> TypedTerm Term -char = int32 . ord - where - ord = fromEnum - --- | Convert a Comparison enum value to a term-encoded term --- Example: comparison ComparisonEqualTo -comparison :: Comparison -> TypedTerm Term -comparison t = case t of - ComparisonEqualTo -> Phantoms.injectUnit _Comparison _Comparison_equalTo - ComparisonLessThan -> Phantoms.injectUnit _Comparison _Comparison_lessThan - ComparisonGreaterThan -> Phantoms.injectUnit _Comparison _Comparison_greaterThan - - --- | Term-encoded function composition (apply g then f) --- Example: compose f g creates a function that applies g then f -compose :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -compose f g = lambda "arg_" $ f @@ (g @@ var "arg_") - --- | Create a term-encoded constant function that always returns the same term-encoded value --- Example: constant (int32 42) -constant :: TypedTerm Term -> TypedTerm Term -constant = lambda ignoredVariable - --- | Create a term-encoded arbitrary-precision exact decimal literal --- Example: decimal 42 -decimal :: Sci.Scientific -> TypedTerm Term -decimal = decimalLift . TypedTerm . Terms.decimal - --- | Lift a TypedTerm Scientific to a term-encoded decimal literal -decimalLift :: TypedTerm Sci.Scientific -> TypedTerm Term -decimalLift = Core.termLiteral . Core.literalDecimal - --- | Term-encoded boolean false literal -false :: TypedTerm Term -false = boolean False - --- | Create a term-encoded field with the given name and term-encoded value --- Example: field "age" (int32 30) -field :: String -> TypedTerm Term -> TypedTerm Field -field s = Core.field (name s) - --- | Create a term-encoded floating-point literal with specified precision --- Example: float (FloatValueFloat32 3.14) -float :: TypedTerm FloatValue -> TypedTerm Term -float = Core.termLiteral . Core.literalFloat - --- | Create a term-encoded 32-bit floating point literal --- Example: float32 3.14 -float32 :: Float -> TypedTerm Term -float32 = float32Lift . TypedTerm . Terms.float32 - --- | Lift a TypedTerm Float to a term-encoded float32 literal --- Example: float32Lift (varPhantom "x" :: TypedTerm Float) -float32Lift :: TypedTerm Float -> TypedTerm Term -float32Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat32 - --- | Create a term-encoded 64-bit floating point literal --- Example: float64 3.14159 -float64 :: Double -> TypedTerm Term -float64 = float64Lift . TypedTerm . Terms.float64 - --- | Lift a TypedTerm Float to a term-encoded float64 literal --- Example: float64Lift (varPhantom "x" :: TypedTerm Float) -float64Lift :: TypedTerm Double -> TypedTerm Term -float64Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat64 - --- | Term-encoded identity function --- Example: identity -identity :: TypedTerm Term -identity = lambda "x_" $ var "x_" - --- | Create a term-encoded union injection --- Example: inject (name "Result") "success" (int32 42) -inject :: AsTerm t Name => t -> String -> TypedTerm Term -> TypedTerm Term -inject tname fname = Core.termInject . Core.injection (asTerm tname) . Core.field (name fname) - -injectPhantom :: Name -> Name -> TypedTerm Term -> TypedTerm Term -injectPhantom tname fname term = Core.termInject $ Core.injection (Core.nameLift tname) $ Core.field (Core.nameLift fname) term - -injectUnit :: AsTerm t Name => t -> String -> TypedTerm Term -injectUnit tname fname = inject tname fname unit - -injectUnitPhantom :: Name -> Name -> TypedTerm Term -injectUnitPhantom tname fname = injectPhantom tname fname Core.termUnit - --- | Create a term-encoded 16-bit signed integer literal --- Example: int16 32767 -int16 :: Int16 -> TypedTerm Term -int16 = int16Lift . TypedTerm . Terms.int16 - --- | Lift a TypedTerm Int16 to a term-encoded int16 literal --- Example: int16Lift (varPhantom "x" :: TypedTerm Int16) -int16Lift :: TypedTerm Int16 -> TypedTerm Term -int16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt16 - --- | Create a meta-level term encoding a 16-bit signed integer literal --- Example: int16Term 100 creates a term that *represents* the int16 literal 100 -int16Term :: Int16 -> TypedTerm Term -int16Term n = inject (Core.nameLift _Term) "literal" $ - inject (Core.nameLift _Literal) "integer" $ - inject (Core.nameLift _IntegerValue) "int16" $ int16 n - --- | Create a term-encoded 32-bit signed integer literal --- Example: int32 42 -int32 :: Int -> TypedTerm Term -int32 = int32Lift . TypedTerm . Terms.int32 - --- | Lift a TypedTerm Int to a term-encoded int32 literal --- Example: int32Lift (varPhantom "x" :: TypedTerm Int) -int32Lift :: TypedTerm Int -> TypedTerm Term -int32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt32 - --- | Create a meta-level term encoding a 32-bit signed integer literal --- Example: int32Term 42 creates a term that *represents* the int32 literal 42 -int32Term :: Int -> TypedTerm Term -int32Term n = inject (Core.nameLift _Term) "literal" $ - inject (Core.nameLift _Literal) "integer" $ - inject (Core.nameLift _IntegerValue) "int32" $ int32 n - --- | Create a term-encoded 64-bit signed integer literal --- Example: int64 9223372036854775807 -int64 :: Int64 -> TypedTerm Term -int64 = int64Lift . TypedTerm . Terms.int64 - --- | Lift a TypedTerm Int64 to a term-encoded int64 literal --- Example: int64Lift (varPhantom "x" :: TypedTerm Int64) -int64Lift :: TypedTerm Int64 -> TypedTerm Term -int64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt64 - --- | Create a meta-level term encoding a 64-bit signed integer literal --- Example: int64Term 137 creates a term that *represents* the int64 literal 137 -int64Term :: Int64 -> TypedTerm Term -int64Term n = inject (Core.nameLift _Term) "literal" $ - inject (Core.nameLift _Literal) "integer" $ - inject (Core.nameLift _IntegerValue) "int64" $ int64 n - --- | Create a term-encoded 8-bit signed integer literal --- Example: int8 127 -int8 :: Int8 -> TypedTerm Term -int8 = int8Lift . TypedTerm . Terms.int8 - --- | Lift a TypedTerm Int8 to a term-encoded int8 literal --- Example: int8Lift (varPhantom "x" :: TypedTerm Int8) -int8Lift :: TypedTerm Int8 -> TypedTerm Term -int8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt8 - --- | Create a term-encoded integer literal with specified bit width --- Example: integer (IntegerValueInt32 42) -integer :: TypedTerm IntegerValue -> TypedTerm Term -integer = Core.termLiteral . Core.literalInteger - --- | Create a term-encoded 'Just' optional value --- Example: just (string "found") -just :: TypedTerm Term -> TypedTerm (Maybe Term) -just = Phantoms.just - --- | Create a term-encoded lambda function with one parameter --- Example: lambda "x" (var "add" @@ var "x" @@ int32 1) -lambda :: String -> TypedTerm Term -> TypedTerm Term -lambda var body = Core.termLambda $ Core.lambda (name var) Phantoms.nothing body - --- | Create a term-encoded lambda with a type annotation --- Example: lambdaTyped "x" T.int32 (var "x") -lambdaTyped :: String -> TypedTerm Type -> TypedTerm Term -> TypedTerm Term -lambdaTyped param dom body = Core.termLambda $ Core.lambda (name param) (Phantoms.just dom) body - --- | Create a term-encoded multi-parameter lambda function (curried form) --- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y") -lambdas :: [String] -> TypedTerm Term -> TypedTerm Term -lambdas params body = case params of - [] -> body - (h:rest) -> Core.termLambda $ Core.lambda (name h) Phantoms.nothing $ lambdas rest body - --- | Create a term-encoded left either value --- Example: left (string "error") -left :: TypedTerm Term -> TypedTerm Term -left t = Core.termEither $ Phantoms.left t - --- | Create a term-encoded let expression with multiple bindings --- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y") -lets :: [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term -> TypedTerm Term -lets pairs body = Core.termLet $ Core.let_ (Phantoms.list $ toBinding pairs) body - where - toBinding = fmap (\(n, t) -> Core.binding n t Phantoms.nothing) - --- | Create a term-encoded let expression with type annotations on bindings --- Example: letsTyped [("x", int32 1, T.mono T.int32)] (var "x") -letsTyped :: [(String, TypedTerm Term, TypedTerm TypeScheme)] -> TypedTerm Term -> TypedTerm Term -letsTyped bindings body = Core.termLet $ Core.let_ (Phantoms.list $ toBinding bindings) body - where - toBinding = fmap (\(n, t, ts) -> Core.binding (name n) t (Phantoms.just ts)) - --- | Create a term-encoded list --- Example: list [int32 1, int32 2, int32 3] -list :: [TypedTerm Term] -> TypedTerm Term -list = Core.termList . Phantoms.list - --- | Create a term-encoded literal from a Literal value --- Example: literal (LiteralInteger (IntegerValueInt32 42)) -literal :: TypedTerm Literal -> TypedTerm Term -literal = Core.termLiteral - --- | Create a term-encoded map/dictionary --- Example: map (fromList [(string "key", int32 42)]) -map :: TypedTerm (M.Map Term Term) -> TypedTerm Term -map = Core.termMap - -mapTerm1 :: TypedTerm (M.Map Term Term) -> TypedTerm Term -mapTerm1 m = inject (Core.nameLift _Term) "map" $ Core.termMap m - --- | Create a term-encoded pattern match on a union --- Example: match (name "Result") nothing ["success">: int32 42, "error">: string "fail"] -match :: AsTerm t Name => t -> TypedTerm (Maybe Term) -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term -match tname def pairs = Core.termCases - $ Core.caseStatement (asTerm tname) def $ Phantoms.list $ toCaseAlternative pairs - where - toCaseAlternative = fmap (\(n, t) -> Core.caseAlternative n t) - ---meta :: TypedTerm a -> TypedTerm Term ---meta (TypedTerm term) = TypedTerm $ EncodeCore.term term - -metaref :: TypedTermDefinition a -> TypedTerm Term -metaref (TypedTermDefinition name _) = Core.termVariable $ Core.nameLift name - --- | Create a meta-level term encoding a Name --- Example: nameTerm "foo" creates a term that *represents* the name "foo" -nameTerm :: String -> TypedTerm Term -nameTerm s = wrap (Core.nameLift _Name) $ string s - --- | Create a term-encoded 'Nothing' optional value -nothing :: TypedTerm (Maybe Term) -nothing = Phantoms.nothing - --- | Create a term-encoded optional value from a Maybe --- Example: optional (just (int32 42)) -optional :: TypedTerm (Maybe Term) -> TypedTerm Term -optional = Core.termOptional - --- | Create a term-encoded pair --- Example: pair (string "name") (int32 42) -pair :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -pair t1 t2 = Core.termPair $ Phantoms.pair t1 t2 - --- | Create a term-encoded reference to a primitive function. --- Uses termVariable; the name resolves via graphPrimitives fallthrough. --- Example: primitive DefStrings.length -primitive :: Terms.ToPrimName n => n -> TypedTerm Term -primitive = Core.termVariable . TypedTerm . EncodeCore.name . Terms.toPrimName - --- | Create a term-encoded field projection function --- Example: project (name "Person") (name "firstName") -project :: (AsTerm t Name, AsTerm f Name) => t -> f -> TypedTerm Term -project tname fname = Core.termProject - $ Core.projection (asTerm tname) (asTerm fname) - --- | Create a term-encoded record with named fields --- Example: record (name "Person") ["name">: string "John", "age">: int32 30] -record :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term -record name pairs = Core.termRecord $ Core.record (asTerm name) $ Phantoms.list (toField <$> pairs) - where - toField (n, t) = Core.field n t - -recordLift :: Name -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term -recordLift name pairs = record (TypedTerm $ EncodeCore.name name) pairs - --- | Create a term-encoded right either value --- Example: right (int32 42) -right :: TypedTerm Term -> TypedTerm Term -right t = Core.termEither $ Phantoms.right t - --- | Create a term-encoded set --- Example: set [string "a", string "b", string "c"] -set :: [TypedTerm Term] -> TypedTerm Term -set els = Core.termSet $ TypedTerm $ TermSet $ S.fromList (unTypedTerm <$> els) - --- | Create a term-encoded string literal --- Example: string "hello world" -string :: String -> TypedTerm Term -string = stringLift . TypedTerm . Terms.string - --- | Lift a TypedTerm String to a term-encoded string literal --- Example: stringLift $ Phantoms.string "hello world" -stringLift :: TypedTerm String -> TypedTerm Term -stringLift = Core.termLiteral . Core.literalString - -stringTerm :: String -> TypedTerm Term -stringTerm s = inject (Core.nameLift _Term) "literal" $ inject (Core.nameLift _Literal) "string" $ string s - --- | Create a term-encoded 3-tuple using nested pairs --- Example: triple (int32 1) (string "test") (boolean True) -triple :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -triple t1 t2 t3 = pair t1 (pair t2 t3) - --- | Term-encoded boolean true literal -true :: TypedTerm Term -true = boolean True - --- | Create a term-encoded tuple with multiple components using nested pairs --- Example: tuple [string "name", int32 42, boolean True] -tuple :: [TypedTerm Term] -> TypedTerm Term -tuple [] = unit -tuple [a] = a -tuple [a, b] = pair a b -tuple (a:rest) = pair a (tuple rest) - --- | Create a term-encoded 2-tuple (same as pair) --- Example: tuple2 (string "name") (int32 42) -tuple2 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -tuple2 = pair - --- | Create a term-encoded 4-tuple using nested pairs --- Example: tuple4 (int32 1) (string "test") (boolean True) (float32 3.14) -tuple4 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -tuple4 t1 t2 t3 t4 = pair t1 (pair t2 (pair t3 t4)) - --- | Create a term-encoded 5-tuple using nested pairs --- Example: tuple5 (int32 1) (string "a") (boolean True) (float32 3.14) (int32 42) -tuple5 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -tuple5 t1 t2 t3 t4 t5 = pair t1 (pair t2 (pair t3 (pair t4 t5))) - --- | Create a term-encoded type application --- Example: tyapp (list []) T.int32 -tyapp :: TypedTerm Term -> TypedTerm Type -> TypedTerm Term -tyapp term typ = Core.termTypeApplication $ Core.typeApplicationTerm term typ - --- | Apply multiple type arguments to a term --- Example: tyapps (pair (int32 1) (string "a")) [T.int32, T.string] -tyapps :: TypedTerm Term -> [TypedTerm Type] -> TypedTerm Term -tyapps = L.foldl tyapp - --- | Create a term-encoded type lambda (System F) --- Example: tylam "t0" (lambda "x" $ var "x") -tylam :: String -> TypedTerm Term -> TypedTerm Term -tylam var body = Core.termTypeLambda $ Core.typeLambda (name var) body - --- | Create multiple term-encoded type lambdas --- Example: tylams ["t0", "t1"] (lambda "x" $ var "x") -tylams :: [String] -> TypedTerm Term -> TypedTerm Term -tylams vars body = L.foldl (\b v -> Core.termTypeLambda $ Core.typeLambda (name v) b) body $ L.reverse vars - --- | Apply type arguments to a polymorphic term (same as tyapps) --- Example: typeApplication (list []) [T.int32] -typeApplication :: TypedTerm Term -> [TypedTerm Type] -> TypedTerm Term -typeApplication = tyapps - --- | Create term-encoded type lambda(s) (same as tylams) --- Example: typeLambda ["t0"] (lambda "x" $ var "x") -typeLambda :: [String] -> TypedTerm Term -> TypedTerm Term -typeLambda = tylams - --- | Create a term-encoded 16-bit unsigned integer literal --- Example: uint16 65535 -uint16 :: Int -> TypedTerm Term -uint16 = uint16Lift . TypedTerm . Terms.uint16 - --- | Lift a TypedTerm Int to a term-encoded uint16 literal --- Example: uint16Lift (varPhantom "x" :: TypedTerm Int) -uint16Lift :: TypedTerm Int -> TypedTerm Term -uint16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint16 - --- | Create a term-encoded 32-bit unsigned integer literal --- Example: uint32 4294967295 -uint32 :: Int64 -> TypedTerm Term -uint32 = uint32Lift . TypedTerm . Terms.uint32 - --- | Lift a TypedTerm Int64 to a term-encoded uint32 literal -uint32Lift :: TypedTerm Int64 -> TypedTerm Term -uint32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint32 - --- | Create a term-encoded 64-bit unsigned integer literal --- Example: uint64 18446744073709551615 -uint64 :: Integer -> TypedTerm Term -uint64 = uint64Lift . TypedTerm . Terms.uint64 - --- | Lift a TypedTerm Integer to a term-encoded uint64 literal --- Example: uint64Lift (varPhantom "x" :: TypedTerm Integer) -uint64Lift :: TypedTerm Integer -> TypedTerm Term -uint64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint64 - --- | Create a term-encoded 8-bit unsigned integer literal --- Example: uint8 255 -uint8 :: Int16 -> TypedTerm Term -uint8 = uint8Lift . TypedTerm . Terms.uint8 - -uint8Lift :: TypedTerm Int16 -> TypedTerm Term -uint8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint8 - --- | Create a term-encoded unit value --- Example: unit -unit :: TypedTerm Term -unit = Core.termUnit - --- | Create a term-encoded unwrap function for a wrapped type --- Example: unwrap (name "Email") -unwrap :: AsTerm t Name => t -> TypedTerm Term -unwrap = Core.termUnwrap . asTerm - --- | Create a term-encoded variable reference from a string --- Example: var "x" -var :: String -> TypedTerm Term -var = Core.termVariable . name - --- | Create a term-encoded variable reference from a Name --- Example: varName (Name "x") -varName :: Name -> TypedTerm Term -varName (Name n) = Core.termVariable $ TypedTerm $ Terms.string n - --- | Create a phantom-typed variable reference from a Name --- Example: varNamePhantom (Name "x") :: TypedTerm Int -varNamePhantom :: Name -> TypedTerm a -varNamePhantom = TypedTerm . TermVariable - --- | Maps a string to a phantom-typed variable term --- Example: varPhantom "x" :: TypedTerm Int -varPhantom :: String -> TypedTerm a -varPhantom = TypedTerm . TermVariable . Name - --- | Create a term-encoded wrapped term (newtype) --- Example: wrap (name "Email") (string "user@example.com") -wrap :: AsTerm t Name => t -> TypedTerm Term -> TypedTerm Term -wrap n = Core.termWrap . Core.wrappedTerm (asTerm n) diff --git a/src/main/haskell/Hydra/Dsl/Meta/Testing.hs b/src/main/haskell/Hydra/Dsl/Meta/Testing.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Testing.hs +++ /dev/null @@ -1,536 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Meta-DSL for constructing test-related terms --- TODO: merge with Hydra.Dsl.Tests - -module Hydra.Dsl.Meta.Testing ( - module Hydra.Dsl.Testing, - module Hydra.Dsl.Meta.Testing, -) where - -import Hydra.Dsl.Testing hiding ( - tag, testCaseUniversal, testCaseWithMetadata, - testCaseWithMetadataCase, testCaseWithMetadataDescription, - testCaseWithMetadataName, testCaseWithMetadataTags, testGroup, - universalTestCase, unTag) -import Hydra.Kernel -import Hydra.Error.Core (InvalidTermError) -import Hydra.Error.Packaging (InvalidModuleError, InvalidPackageError) -import Hydra.Testing as Testing -import Hydra.Dsl.Meta.Phantoms as Phantoms hiding ((++)) -import qualified Hydra.Dsl.Meta.Lib.Eithers as Eithers -import qualified Hydra.Dsl.Meta.Lib.Lists as Lists -import qualified Hydra.Dsl.Meta.Lib.Optionals as Optionals -import qualified Hydra.Dsl.Meta.Lib.Pairs as Pairs -import qualified Hydra.Dsl.Meta.Lib.Strings as Strings -import qualified Hydra.Dsl.Meta.Terms as MetaTerms -import Hydra.Dsl.Terms (ToPrimName) -import qualified Hydra.Dsl.Meta.Types as T -import qualified Hydra.Dsl.Validation as Validation - -import qualified Data.Int as I -import qualified Data.List as L -import qualified Data.Map as M - -type Int32 = I.Int32 - - -tag_disabled = Tag "disabled" -tag_disabledForMinimalInference = Tag "disabledForMinimalInference" - -alphaConvertRef :: TypedTerm (Name -> Name -> Term -> Term) -alphaConvertRef = TypedTerm $ TermVariable $ Name "hydra.reduction.alphaConvert" - -betaReduceTypeRef :: TypedTerm (InferenceContext -> Graph -> Type -> Either Error Type) -betaReduceTypeRef = TypedTerm $ TermVariable $ Name "hydra.reduction.betaReduceType" - --- | Refs for hydra.validate.packaging validators and their show functions. -checkConflictingModuleNamesRef :: TypedTerm (Package -> Maybe InvalidPackageError) -checkConflictingModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkConflictingModuleNames" - -checkConflictingVariantNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkConflictingVariantNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkConflictingVariantNames" - -checkDefinitionDocumentationRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkDefinitionDocumentationRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionDocumentation" - -checkDefinitionModuleNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkDefinitionModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionModuleNames" - -checkDefinitionNameConventionRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkDefinitionNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionNameConvention" - -checkDefinitionOrderingRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkDefinitionOrderingRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionOrdering" - -checkDuplicateDefinitionNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkDuplicateDefinitionNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDuplicateDefinitionNames" - -checkDuplicateModuleNamesRef :: TypedTerm (Package -> Maybe InvalidPackageError) -checkDuplicateModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDuplicateModuleNames" - -checkModuleNameConventionRef :: TypedTerm (Module -> Maybe InvalidModuleError) -checkModuleNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkModuleNameConvention" - -checkPackageNameConventionRef :: TypedTerm (Package -> Maybe InvalidPackageError) -checkPackageNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkPackageNameConvention" - --- | 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) - (testCaseUniversal $ universalTestCase - (retype $ Eithers.either_ - (Phantoms.lambda "e" (Phantoms.string "<>")) - (Phantoms.lambda "result" - (showTypeRef @@ (typeSchemeToFTypeRef @@ Pairs.second (Pairs.first (Phantoms.var "result"))))) - (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ input)) - (retype $ showTypeRef @@ outputType)) - nothing (Phantoms.list $ tag . unTag <$> tags) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - -evalCase :: String -> TypedTerm Term -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -evalCase cname input output = evalCaseWithTags cname [] input output - --- | Create a universal test case that evaluates a Term via reduceTerm and compares the result. -evalCaseWithTags :: String -> [Tag] -> TypedTerm Term -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -evalCaseWithTags cname tags input output = testCaseWithMetadata (Phantoms.string cname) - (testCaseUniversal $ universalTestCase - (retype $ Eithers.either_ - (Phantoms.lambda "e" (Phantoms.string "<>")) - (Phantoms.lambda "t" (showTermRef @@ Phantoms.var "t")) - (reduceTermRef @@ testContextRef @@ testGraphRef @@ true @@ input)) - (retype $ showTermRef @@ output)) - nothing (Phantoms.list $ tag . unTag <$> tags) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Create a universal test case for an expression with a show function -evalPair :: String -> TypedTerm (t -> String) -> TypedTerm t -> TypedTerm t -> TypedTerm TestCaseWithMetadata -evalPair cname showFn logicalActual logicalExpected = universalCase cname - (retype $ showFn @@ logicalActual) (retype $ showFn @@ logicalExpected) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | evalPair with tags -evalPairWithTags :: String -> [Tag] -> TypedTerm (t -> String) -> TypedTerm t -> TypedTerm t -> TypedTerm TestCaseWithMetadata -evalPairWithTags cname tags showFn logicalActual logicalExpected = testCaseWithMetadata (Phantoms.string cname) - (testCaseUniversal $ universalTestCase (retype $ showFn @@ logicalActual) (retype $ showFn @@ logicalExpected)) - nothing (Phantoms.list $ tag . unTag <$> tags) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - -expectFailure :: AsTerm t Term => Int -> [Tag] -> t -> TypedTerm TestCaseWithMetadata -expectFailure i tags term = infFailureTest ("#" ++ show i) tags (asTerm term) - -expectMono :: AsTerm t Term => Int -> [Tag] -> t -> TypedTerm Type -> TypedTerm TestCaseWithMetadata -expectMono i tags term typ = infTest ("#" ++ show i) tags (asTerm term) $ T.mono typ - -expectPoly :: AsTerm t Term => Int -> [Tag] -> t -> [String] -> TypedTerm Type -> TypedTerm TestCaseWithMetadata -expectPoly i tags term params typ = infTest ("#" ++ show i) tags (asTerm term) $ T.poly params typ - -expectPolyConstrained :: AsTerm t Term => Int -> [Tag] -> t -> [String] -> [(String, [String])] -> TypedTerm Type -> TypedTerm TestCaseWithMetadata -expectPolyConstrained i tags term params constraints typ = infTest ("#" ++ show i) tags (asTerm term) $ T.polyConstrained params constraints typ - -groupRef = MetaTerms.varNamePhantom . bindingName - --- | Inference failure test: expects inference to fail. -infFailureTest :: String -> [Tag] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -infFailureTest name tags term = testCaseWithMetadata (Phantoms.string name) - (testCaseUniversal $ universalTestCase - (retype $ Eithers.either_ - (Phantoms.lambda "e" (Phantoms.string "FAIL")) - (Phantoms.lambda "result" (Strings.cat2 (Phantoms.string "unexpected: ") - (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result"))))) - (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) - (Phantoms.string "FAIL")) - nothing (Phantoms.list $ tag . unTag <$> tags) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Inference test: infer type and compare with expected type scheme. -infTest :: String -> [Tag] -> TypedTerm Term -> TypedTerm TypeScheme -> TypedTerm TestCaseWithMetadata -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 "result" - (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result")))) - (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) - (retype $ showTypeSchemeRef @@ ts)) - nothing (Phantoms.list $ tag . unTag <$> tags) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - -isDisabled tcase = tag_disabled `L.elem` Testing.testCaseWithMetadataTags tcase -isDisabledForMinimalInference tcase = tag_disabledForMinimalInference `L.elem` Testing.testCaseWithMetadataTags tcase - -inferTypeOfRef :: TypedTerm (InferenceContext -> Graph -> Term -> Either Error ((Term, TypeScheme), InferenceContext)) -inferTypeOfRef = TypedTerm $ TermVariable $ Name "hydra.inference.inferTypeOf" - --- | Reference to the kernel-default core validation profile (term + type --- rules; 'singleVariantUnion' classified as a warning, everything else --- as an error; maxErrors=1). -kernelDefaultCoreProfileRef :: TypedTerm ValidationProfile -kernelDefaultCoreProfileRef = TypedTerm $ TermVariable $ Name "hydra.validate.core.kernelDefaultCoreProfile" - --- | Reference to the kernel-default packaging validation profile (every --- per-module and per-package check classified as an error; maxErrors=1). -kernelDefaultPackagingProfileRef :: TypedTerm ValidationProfile -kernelDefaultPackagingProfileRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelDefaultPackagingProfile" - --- | Reference to the kernel-strict 'kernelModule' convenience wrapper --- (Maybe-returning, applies 'kernelDefaultPackagingProfile' internally). --- Used by the kernelModule orchestrator tests in --- 'Sources/Test/Validate/Packaging.hs'. -kernelModuleRef :: TypedTerm (Module -> Maybe InvalidModuleError) -kernelModuleRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelModule" - --- | Reference to the kernel-strict 'kernelPackage' convenience wrapper. -kernelPackageRef :: TypedTerm (Package -> Maybe InvalidPackageError) -kernelPackageRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelPackage" - -mapTerm :: [(TypedTerm Term, TypedTerm Term)] -> TypedTerm Term -mapTerm pairs = TypedTerm $ TermInject $ Injection _Term $ Field _Term_map $ TermMap $ M.fromList [(unTypedTerm k, unTypedTerm v) | (k, v) <- pairs] - -mapTermEmpty :: TypedTerm (M.Map k v) -mapTermEmpty = TypedTerm $ TermMap M.empty - --- | Type checking test where term doesn't change (just check the inferred type) -noChange :: String -> TypedTerm Term -> TypedTerm Type -> TypedTerm TestCaseWithMetadata -noChange name term typ = checkTest name [] term term typ - -noTags :: TypedTerm [Tag] -noTags = Phantoms.list ([] :: [TypedTerm Tag]) - -primCase :: ToPrimName n => String -> n -> [TypedTerm Term] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -primCase cname prim args output = primCaseWithTags cname [] prim args output - -primCaseWithTags :: ToPrimName n => String -> [Tag] -> n -> [TypedTerm Term] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -primCaseWithTags cname tags prim args output = evalCaseWithTags cname tags input output - where - input = L.foldl (MetaTerms.@@) (MetaTerms.primitive prim) args - -reduceTermRef :: TypedTerm (InferenceContext -> Graph -> Bool -> Term -> Either Error Term) -reduceTermRef = TypedTerm $ TermVariable $ Name "hydra.reduction.reduceTerm" - -removeTypesFromTermRef :: TypedTerm (Term -> Term) -removeTypesFromTermRef = TypedTerm $ TermVariable $ Name "hydra.strip.removeTypesFromTerm" - -showInvalidModuleErrorRef :: TypedTerm (InvalidModuleError -> String) -showInvalidModuleErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidModuleError" - -showInvalidPackageErrorRef :: TypedTerm (InvalidPackageError -> String) -showInvalidPackageErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidPackageError" - -showInvalidTermErrorRef :: TypedTerm (InvalidTermError -> String) -showInvalidTermErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.core.invalidTermError" - -showTermRef :: TypedTerm (Term -> String) -showTermRef = TypedTerm $ TermVariable $ Name "hydra.show.core.term" - -showTypeRef :: TypedTerm (Type -> String) -showTypeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.type" - -showTypeSchemeRef :: TypedTerm (TypeScheme -> String) -showTypeSchemeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.typeScheme" - --- | evalPair for String-typed expressions (identity show) -stringEvalPair :: String -> TypedTerm String -> TypedTerm String -> TypedTerm TestCaseWithMetadata -stringEvalPair cname = evalPair cname (Phantoms.lambda "s" (Phantoms.var "s")) - -subgroup :: AsTerm t TestCaseWithMetadata => String -> [t] -> TypedTerm TestGroup -subgroup name cases = tgroup name Nothing [] (asTerm <$> cases) - -supergroup :: AsTerm t TestGroup => String -> [t] -> TypedTerm TestGroup -supergroup name subgroups = tgroup name Nothing (asTerm <$> subgroups) [] - -tag :: String -> TypedTerm Tag -tag = Phantoms.wrap _Tag . Phantoms.string - -testContextRef :: TypedTerm InferenceContext -testContextRef = TypedTerm $ TermVariable $ Name "hydra.test.testGraph.testContext" - --- | References to kernel functions (avoids circular imports) -testGraphRef :: TypedTerm Graph -testGraphRef = TypedTerm $ TermVariable $ Name "hydra.test.testGraph.testGraph" - -tgroup :: String -> Maybe String -> [TypedTerm TestGroup] -> [TypedTerm TestCaseWithMetadata] -> TypedTerm TestGroup -tgroup name mdesc subgroups cases = testGroup (Phantoms.string name) (opt (Phantoms.string <$> mdesc)) (Phantoms.list subgroups) (Phantoms.list cases) - -typeSchemeToFTypeRef :: TypedTerm (TypeScheme -> Type) -typeSchemeToFTypeRef = TypedTerm $ TermVariable $ Name "hydra.scoping.typeSchemeToFType" - -universalCase :: String -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata -universalCase cname actual expected = testCaseWithMetadata (Phantoms.string cname) - (testCaseUniversal $ universalTestCase (retype actual) (retype expected)) - nothing noTags - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Reference to the profile-aware core term validator. Used by --- 'validateCoreTermCase' (with 'kernelDefaultCoreProfileRef'-applied, --- head-extracted to preserve the legacy 'Maybe E' shape) and by --- 'validateCoreTermCaseWithProfile' (with an explicit profile). -validateCoreTermProfiledRef :: TypedTerm (ValidationProfile -> Bool -> Graph -> Term -> ValidationResult InvalidTermError) -validateCoreTermProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.core.term" - --- | Reference to the profile-aware packaging module validator. Used by --- 'validatePackagingModuleCaseWithProfile' directly. -validatePackagingModuleProfiledRef :: TypedTerm (ValidationProfile -> ValidationResult InvalidModuleError -> Module -> ValidationResult InvalidModuleError) -validatePackagingModuleProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.module" - --- | Reference to the profile-aware packaging package validator. Returns a --- 'ValidationResult InvalidPackageError'; used by --- 'validatePackagingPackageCaseWithProfile'. -validatePackagingPackageProfiledRef :: TypedTerm (ValidationProfile -> ValidationResult InvalidPackageError -> Package -> ValidationResult InvalidPackageError) -validatePackagingPackageProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.package" - ----------------------------------------- - --- | Convenience function for creating alpha conversion test cases -alphaCase :: String -> TypedTerm Term -> TypedTerm Name -> TypedTerm Name -> TypedTerm Term -> TypedTerm TestCaseWithMetadata -alphaCase cname term oldVar newVar result = universalCase cname - (retype $ showTermRef @@ (alphaConvertRef @@ oldVar @@ newVar @@ term)) - (retype $ showTermRef @@ result) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - -encodedTestGroupToBinding :: ModuleName -> String -> TypedTerm TestGroup -> Binding -encodedTestGroupToBinding ns lname group = Binding name (unTypedTerm group) - $ Just $ TypeScheme [] typ Nothing - where - name = unqualifyName $ QualifiedName (Just ns) lname - typ = TypeVariable _TestGroup - --- | Render a 'ValidationResult InvalidModuleError' as a string of the form --- "errors=[s1;s2] warnings=[w1]". Counterpart of 'showValidationResultTerm' --- 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 ";") $ - 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 ";") $ - Lists.map (Phantoms.lambda "w" $ showInvalidModuleErrorRef @@ Phantoms.var "w") - (Validation.validationResultWarnings vr)) - (Phantoms.string "]")) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Render a 'ValidationResult InvalidPackageError' as a string. Package-level --- 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 ";") $ - 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 ";") $ - Lists.map (Phantoms.lambda "w" $ showInvalidPackageErrorRef @@ Phantoms.var "w") - (Validation.validationResultWarnings vr)) - (Phantoms.string "]")) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Profile-aware variant of 'validatePackagingModuleCase'. Calls --- 'hydra.validate.packaging.module'' (the new orchestrator) starting from --- an empty 'ValidationResult' and compares the full result shape against --- the expected. -validatePackagingModuleCaseWithProfile - :: String - -> TypedTerm ValidationProfile - -> TypedTerm Module - -> TypedTerm (ValidationResult InvalidModuleError) - -> TypedTerm TestCaseWithMetadata -validatePackagingModuleCaseWithProfile cname profile input expected = universalCase cname - (showValidationResultModule - (validatePackagingModuleProfiledRef @@ profile @@ emptyResultModule @@ input)) - (showValidationResultModule expected) - where - emptyResultModule :: TypedTerm (ValidationResult InvalidModuleError) - emptyResultModule = Validation.validationResult - (Phantoms.list ([] :: [TypedTerm InvalidModuleError])) - (Phantoms.list ([] :: [TypedTerm InvalidModuleError])) - --- | Profile-aware variant of 'validatePackagingPackageCase'. -validatePackagingPackageCaseWithProfile - :: String - -> TypedTerm ValidationProfile - -> TypedTerm Package - -> TypedTerm (ValidationResult InvalidPackageError) - -> TypedTerm TestCaseWithMetadata -validatePackagingPackageCaseWithProfile cname profile input expected = universalCase cname - (showValidationResultPackage - (validatePackagingPackageProfiledRef @@ profile @@ emptyResultPackage @@ input)) - (showValidationResultPackage expected) - where - emptyResultPackage :: TypedTerm (ValidationResult InvalidPackageError) - emptyResultPackage = Validation.validationResult - (Phantoms.list ([] :: [TypedTerm InvalidPackageError])) - (Phantoms.list ([] :: [TypedTerm InvalidPackageError])) - --- | Render a 'ValidationResult InvalidTermError' as a string of the form --- "errors=[s1;s2] warnings=[w1]". Used to compare actual vs expected --- '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 ";") $ - 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 ";") $ - Lists.map (Phantoms.lambda "w" $ showInvalidTermErrorRef @@ Phantoms.var "w") - (Validation.validationResultWarnings vr)) - (Phantoms.string "]")) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Profile-aware variant of 'validateCoreTermCase'. Compares the full --- 'ValidationResult' shape — both errors and warnings — against the --- expected, allowing the caller to specify any profile (not just the --- kernel default). Use for tests that exercise multi-error --- accumulation, warning vs error classification, or rule disabling. -validateCoreTermCaseWithProfile - :: String - -> TypedTerm ValidationProfile - -> TypedTerm Bool - -> TypedTerm Term - -> TypedTerm (ValidationResult InvalidTermError) - -> TypedTerm TestCaseWithMetadata -validateCoreTermCaseWithProfile cname profile typed input expected = universalCase cname - (showValidationResultTerm - (validateCoreTermProfiledRef @@ profile @@ typed @@ testGraphRef @@ input)) - (showValidationResultTerm expected) - -testCaseUniversal :: TypedTerm UniversalTestCase -> TypedTerm TestCase -testCaseUniversal = inject _TestCase _TestCase_universal - -testCaseWithMetadata :: TypedTerm String -> TypedTerm TestCase -> TypedTerm (Maybe String) -> TypedTerm [Tag] -> TypedTerm TestCaseWithMetadata -testCaseWithMetadata name tcase description tags = Phantoms.record _TestCaseWithMetadata [ - _TestCaseWithMetadata_name>>: name, - _TestCaseWithMetadata_case>>: tcase, - _TestCaseWithMetadata_description>>: description, - _TestCaseWithMetadata_tags>>: tags] - -testCaseWithMetadataCase :: TypedTerm (TestCaseWithMetadata -> TestCase) -testCaseWithMetadataCase = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_case - -testCaseWithMetadataDescription :: TypedTerm (TestCaseWithMetadata -> Maybe String) -testCaseWithMetadataDescription = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_description - -testCaseWithMetadataName :: TypedTerm (TestCaseWithMetadata -> String) -testCaseWithMetadataName = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_name - -testCaseWithMetadataTags :: TypedTerm (TestCaseWithMetadata -> [Tag]) -testCaseWithMetadataTags = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_tags - -testGroup :: TypedTerm String -> TypedTerm (Maybe String) -> TypedTerm [TestGroup] -> TypedTerm [TestCaseWithMetadata] -> TypedTerm TestGroup -testGroup name description subgroups cases = Phantoms.record _TestGroup [ - _TestGroup_name>>: name, - _TestGroup_description>>: description, - _TestGroup_subgroups>>: subgroups, - _TestGroup_cases>>: cases] - --- | Convenience function for creating type reduction test cases -typeRedCase :: String -> TypedTerm Type -> TypedTerm Type -> TypedTerm TestCaseWithMetadata -typeRedCase cname input output = universalCase cname - (retype $ Eithers.either_ - (Phantoms.lambda "e" (Phantoms.string "<>")) - (Phantoms.lambda "t" (showTypeRef @@ Phantoms.var "t")) - (betaReduceTypeRef @@ testContextRef @@ testGraphRef @@ input)) - (retype $ showTypeRef @@ output) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Build a 'UniversalTestCase' from two string-producing expressions. --- Each expression is wrapped in a unit-lambda so its evaluation is deferred --- until the runner forces the thunk inside its per-test timing bracket. See --- issue #311: without thunking, eagerly-evaluated hosts (Scala, the four --- complete Lisps) compute 'actual'/'expected' at test-data load time, before --- any timer starts, and report zero elapsed time. -universalTestCase :: TypedTerm String -> TypedTerm String -> TypedTerm UniversalTestCase -universalTestCase actual expected = Phantoms.record _UniversalTestCase [ - _UniversalTestCase_actual Phantoms.>>: thunk actual, - _UniversalTestCase_expected Phantoms.>>: thunk expected] - where - thunk :: TypedTerm String -> TypedTerm (() -> String) - thunk body = Phantoms.lambda "_" body - --- | Convenience function for creating validation test cases. Drives the --- profile-aware 'hydra.validate.core.term' with the kernel-default core --- profile and head-extracts the resulting errors list — preserving the --- legacy 'Maybe InvalidTermError' shape that existing test data uses. --- Tests that need to assert multi-error accumulation, warning --- classification, or rule disabling should use --- 'validateCoreTermCaseWithProfile' instead. -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 $ - validateCoreTermProfiledRef @@ kernelDefaultCoreProfileRef @@ typed @@ testGraphRef @@ input) - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidTermErrorRef @@ Phantoms.var "e"))) - (retype $ Optionals.cases - expected - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidTermErrorRef @@ Phantoms.var "e"))) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Convenience function for creating module-validation test cases. --- Applies a packaging-level Module validator to an input module and compares --- the result against the expected Maybe InvalidModuleError. -validatePackagingModuleCase :: String -> TypedTerm (Module -> Maybe InvalidModuleError) -> TypedTerm Module -> TypedTerm (Maybe InvalidModuleError) -> TypedTerm TestCaseWithMetadata -validatePackagingModuleCase cname validator input expected = universalCase cname - (retype $ Optionals.cases - (validator @@ input) - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidModuleErrorRef @@ Phantoms.var "e"))) - (retype $ Optionals.cases - expected - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidModuleErrorRef @@ Phantoms.var "e"))) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t - --- | Convenience function for creating package-validation test cases. --- Applies a packaging-level Package validator to an input package and compares --- the result against the expected Maybe InvalidPackageError. -validatePackagingPackageCase :: String -> TypedTerm (Package -> Maybe InvalidPackageError) -> TypedTerm Package -> TypedTerm (Maybe InvalidPackageError) -> TypedTerm TestCaseWithMetadata -validatePackagingPackageCase cname validator input expected = universalCase cname - (retype $ Optionals.cases - (validator @@ input) - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidPackageErrorRef @@ Phantoms.var "e"))) - (retype $ Optionals.cases - expected - (Phantoms.string "valid") - (Phantoms.lambda "e" (showInvalidPackageErrorRef @@ Phantoms.var "e"))) - where - retype :: TypedTerm x -> TypedTerm String - retype (TypedTerm t) = TypedTerm t diff --git a/src/main/haskell/Hydra/Dsl/Meta/Types.hs b/src/main/haskell/Hydra/Dsl/Meta/Types.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Types.hs +++ /dev/null @@ -1,298 +0,0 @@ --- | A domain-specific language for constructing term-encoded Hydra types in Haskell; --- these functions enable you to build terms (programs) which build types. - -{-# LANGUAGE FlexibleContexts #-} - -module Hydra.Dsl.Meta.Types ( - module Hydra.Dsl.Meta.Base, - module Hydra.Dsl.Meta.Types, -) where - -import Hydra.Kernel -import Hydra.Dsl.AsTerm -import qualified Hydra.Dsl.Meta.Phantoms as Phantoms -import qualified Hydra.Dsl.Meta.Lib.Maps as Maps -import Hydra.Dsl.Meta.Core as Core hiding (name, unName) -import Hydra.Dsl.Meta.Base - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Maybe as Y -import qualified Data.Set as S -import Prelude hiding (either, map, maybe, product, sum) - - --- Operators - --- | Type application operator --- Example: typeConstructor @@ typeArg -(@@) :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -(@@) = apply - --- | Function type constructor operator --- Example: int32 --> string -(-->) :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -(-->) = function - - --- | Attach an annotation map to a term-encoded type, wrapping the map as a --- TermMap annotation per Hydra's convention (#386). Each Name key is lifted --- to a TermVariable. --- Example: annot annotationMap myType -annot :: TypedTerm (M.Map Name Term) -> TypedTerm Type -> TypedTerm Type -annot ann typ = typeAnnotated $ annotatedType typ - (Core.termMap (Maps.mapKeys (Phantoms.lambda "n" (Core.termVariable (Phantoms.var "n"))) ann)) - --- | Apply a term-encoded type to a type argument --- Example: apply (var "Maybe") int32 -apply :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -apply l r = typeApplication $ applicationType l r - -applys :: TypedTerm Type -> [TypedTerm Type] -> TypedTerm Type -applys t ts = L.foldl apply t ts - --- | Create a term-encoded arbitrary-precision integer type --- Example: bigint -bigint :: TypedTerm Type -bigint = typeLiteral $ literalTypeInteger integerTypeBigint - --- | Create a term-encoded binary type --- Example: binary -binary :: TypedTerm Type -binary = typeLiteral literalTypeBinary - --- | Create a term-encoded boolean type --- Example: boolean -boolean :: TypedTerm Type -boolean = typeLiteral literalTypeBoolean - --- | Create a term-encoded arbitrary-precision decimal type --- Example: decimal -decimal :: TypedTerm Type -decimal = typeLiteral literalTypeDecimal - --- | Create a term-encoded either type --- Example: either_ string int32 -either_ :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -either_ l r = typeEither $ eitherType l r - --- | Create a term-encoded enum type with the given variant names (conventionally in camelCase) --- Example: enum (name "Color") ["red", "green", "blue"] --- Accepts TypedTerm Name or TypedBinding Name (via AsTerm) -enum :: AsTerm t Name => t -> [String] -> TypedTerm Type -enum tname names = union tname $ (\n -> (name n, unit)) <$> names - --- | Create a term-encoded field with the given name and type --- Example: field "age" int32 -field :: String -> TypedTerm Type -> TypedTerm FieldType -field s = fieldType (name s) - --- | Create a term-encoded FloatType representation --- Example: float FloatTypeFloat64 -float :: FloatType -> TypedTerm FloatType -float t = Phantoms.injectUnit _FloatType $ case t of - FloatTypeFloat32 -> _FloatType_float32 - FloatTypeFloat64 -> _FloatType_float64 - --- | Create a term-encoded 32-bit floating point type --- Example: float32 -float32 :: TypedTerm Type -float32 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat32 - --- | Create a term-encoded 64-bit floating point type --- Example: float64 -float64 :: TypedTerm Type -float64 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat64 - --- | Create a term-encoded universal quantification (polymorphic type) --- Example: forAll "a" (var "a" --> var "a") -forAll :: String -> TypedTerm Type -> TypedTerm Type -forAll var body = typeForall $ forallType (name var) body - -forAlls :: [String] -> TypedTerm Type -> TypedTerm Type -forAlls vs body = L.foldr forAll body vs - --- | Create a term-encoded function type --- Example: function int32 string -function :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -function dom cod = typeFunction $ functionType dom cod - --- | Create a term-encoded multi-parameter function type --- Example: functionMany [int32, string, boolean] -functionMany :: [TypedTerm Type] -> TypedTerm Type -functionMany types = case types of - [t] -> t - t:ts -> function t $ functionMany ts - --- | Create a term-encoded 16-bit signed integer type --- Example: int16 -int16 :: TypedTerm Type -int16 = typeLiteral $ literalTypeInteger integerTypeInt16 - --- | Create a term-encoded 32-bit signed integer type --- Example: int32 -int32 :: TypedTerm Type -int32 = typeLiteral $ literalTypeInteger integerTypeInt32 - --- | Create a term-encoded 64-bit signed integer type --- Example: int64 -int64 :: TypedTerm Type -int64 = typeLiteral $ literalTypeInteger integerTypeInt64 - --- | Create a term-encoded 8-bit signed integer type --- Example: int8 -int8 :: TypedTerm Type -int8 = typeLiteral $ literalTypeInteger integerTypeInt8 - --- | Create a term-encoded IntegerType representation --- Example: integer IntegerTypeInt32 -integer :: IntegerType -> TypedTerm IntegerType -integer t = Phantoms.injectUnit _IntegerType $ case t of - IntegerTypeBigint -> _IntegerType_bigint - IntegerTypeInt8 -> _IntegerType_int8 - IntegerTypeInt16 -> _IntegerType_int16 - IntegerTypeInt32 -> _IntegerType_int32 - IntegerTypeInt64 -> _IntegerType_int64 - IntegerTypeUint8 -> _IntegerType_uint8 - IntegerTypeUint16 -> _IntegerType_uint16 - IntegerTypeUint32 -> _IntegerType_uint32 - IntegerTypeUint64 -> _IntegerType_uint64 - --- | Create a term-encoded list type --- Example: list string -list :: TypedTerm Type -> TypedTerm Type -list = typeList - --- | Create a term-encoded literal type from a LiteralType value --- Example: literal (literalTypeInteger integerTypeInt32) -literal :: TypedTerm LiteralType -> TypedTerm Type -literal = typeLiteral - --- | Create a term-encoded map/dictionary type --- Example: map string int32 -map :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -map k v = typeMap $ mapType k v - --- | Create a term-encoded monomorphic type scheme --- Example: mono int32 -mono :: TypedTerm Type -> TypedTerm TypeScheme -mono t = Phantoms.record _TypeScheme [ - Phantoms.field _TypeScheme_variables $ Phantoms.list ([] :: [TypedTerm Name]), - Phantoms.field _TypeScheme_body t, - Phantoms.field _TypeScheme_constraints Phantoms.nothing] - --- | Term-encoded non-negative 32-bit integer type --- Currently an alias for int32; intended for semantic annotation --- In future versions, this may include validation constraints --- Example: nonNegativeInt32 -nonNegativeInt32 :: TypedTerm Type -nonNegativeInt32 = Hydra.Dsl.Meta.Types.int32 - --- | Create a term-encoded optional (nullable) type --- Example: optional string -optional :: TypedTerm Type -> TypedTerm Type -optional = typeOptional - --- | Create a term-encoded pair type --- Example: pair string int32 -pair :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type -pair first second = Core.typePair $ Core.pairType first second - --- | Create a term-encoded polymorphic type scheme --- Example: poly ["a", "b"] (var "a" --> var "b") -poly :: [String] -> TypedTerm Type -> TypedTerm TypeScheme -poly params t = Phantoms.record _TypeScheme [ - Phantoms.field _TypeScheme_variables (Phantoms.list (name <$> params)), - Phantoms.field _TypeScheme_body t, - Phantoms.field _TypeScheme_constraints Phantoms.nothing] - --- | Create a term-encoded polymorphic type scheme with class constraints --- Example: polyConstrained ["k", "v"] [("k", ["ordering"])] (map (var "k") (var "v")) -polyConstrained :: [String] -> [(String, [String])] -> TypedTerm Type -> TypedTerm TypeScheme -polyConstrained params constraints t = Phantoms.record _TypeScheme [ - Phantoms.field _TypeScheme_variables (Phantoms.list (name <$> params)), - Phantoms.field _TypeScheme_body t, - Phantoms.field _TypeScheme_constraints constraintsTerm] - where - constraintsTerm = Phantoms.just $ Phantoms.map $ M.fromList - [(name v, Core.typeVariableConstraints (Phantoms.list (Core.typeClassConstraintSimple . name <$> classes))) - | (v, classes) <- constraints] - --- | Create a term-encoded product type (tuple) with multiple components using nested pairs --- Example: product [string, int32, boolean] -product :: [TypedTerm Type] -> TypedTerm Type -product [] = unit -product [a] = a -product [a, b] = pair a b -product (a:rest) = pair a (product rest) - --- | Create a term-encoded record type with named fields --- Example: record (name "Person") ["name">: string, "age">: int32] --- Note: the name parameter is now ignored; record types no longer carry a type name -record :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Type)] -> TypedTerm Type -record _n pairs = typeRecord $ Phantoms.list (toField <$> pairs) - where - toField (fn, t) = fieldType fn t - --- | Create a term-encoded set type --- Example: set string -set :: TypedTerm Type -> TypedTerm Type -set = typeSet - --- | Create a term-encoded string type --- Example: string -string :: TypedTerm Type -string = typeLiteral literalTypeString - --- | Create a term-encoded 16-bit unsigned integer type --- Example: uint16 -uint16 :: TypedTerm Type -uint16 = typeLiteral $ literalTypeInteger integerTypeUint16 - --- | Create a term-encoded 32-bit unsigned integer type --- Example: uint32 -uint32 :: TypedTerm Type -uint32 = typeLiteral $ literalTypeInteger integerTypeUint32 - --- | Create a term-encoded 64-bit unsigned integer type --- Example: uint64 -uint64 :: TypedTerm Type -uint64 = typeLiteral $ literalTypeInteger integerTypeUint64 - --- | Create a term-encoded 8-bit unsigned integer type --- Example: uint8 -uint8 :: TypedTerm Type -uint8 = typeLiteral $ literalTypeInteger integerTypeUint8 - --- | Create a term-encoded union type with named variants --- Example: union (name "Result") ["success">: int32, "error">: string] --- Note: the name parameter is now ignored; union types no longer carry a type name -union :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Type)] -> TypedTerm Type -union _n pairs = typeUnion $ Phantoms.list (toField <$> pairs) - where - toField (fn, ft) = fieldType fn ft - --- | Term-encoded unit type (empty record type) --- Example: unit -unit :: TypedTerm Type -unit = typeUnit - --- | Create a term-encoded type variable (alias for 'variable') --- Example: var "a" -var :: String -> TypedTerm Type -var = variable - --- | Create a term-encoded type variable --- Example: variable "a" -variable :: String -> TypedTerm Type -variable = typeVariable . name - --- | Term-encoded void type (uninhabited / bottom type) --- Example: void -void :: TypedTerm Type -void = typeVoid - --- | Create a term-encoded wrapped type (newtype) --- Note: the name parameter is now ignored; wrapped types no longer carry a type name -wrap :: AsTerm t Name => t -> TypedTerm Type -> TypedTerm Type -wrap _n t = typeWrap t diff --git a/src/main/haskell/Hydra/Dsl/Meta/Variants.hs b/src/main/haskell/Hydra/Dsl/Meta/Variants.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Meta/Variants.hs +++ /dev/null @@ -1,68 +0,0 @@ --- | Haskell-specific convenience layer over the generated Hydra.Dsl.Variants module. --- Adds Haskell enum -> TypedTerm converter functions. - -module Hydra.Dsl.Meta.Variants ( - module Hydra.Dsl.Variants, - module Hydra.Dsl.Meta.Variants, -) where - -import Hydra.Kernel -import Hydra.Dsl.Meta.Phantoms -import Hydra.Dsl.Variants - - --- | Convert a Haskell LiteralVariant to a TypedTerm -literalVariant :: LiteralVariant -> TypedTerm LiteralVariant -literalVariant v = injectUnit _LiteralVariant $ case v of - LiteralVariantBinary -> _LiteralVariant_binary - LiteralVariantBoolean -> _LiteralVariant_boolean - LiteralVariantDecimal -> _LiteralVariant_decimal - LiteralVariantFloat -> _LiteralVariant_float - LiteralVariantInteger -> _LiteralVariant_integer - LiteralVariantString -> _LiteralVariant_string - --- | Convert a Haskell TermVariant to a TypedTerm -termVariant :: TermVariant -> TypedTerm TermVariant -termVariant v = injectUnit _TermVariant $ case v of - TermVariantAnnotated -> _TermVariant_annotated - TermVariantApplication -> _TermVariant_application - TermVariantCases -> _TermVariant_cases - TermVariantEither -> _TermVariant_either - TermVariantLambda -> _TermVariant_lambda - TermVariantLet -> _TermVariant_let - TermVariantList -> _TermVariant_list - TermVariantLiteral -> _TermVariant_literal - TermVariantMap -> _TermVariant_map - TermVariantOptional -> _TermVariant_optional - TermVariantPair -> _TermVariant_pair - TermVariantProject -> _TermVariant_project - TermVariantRecord -> _TermVariant_record - TermVariantSet -> _TermVariant_set - TermVariantTypeLambda -> _TermVariant_typeLambda - TermVariantTypeApplication -> _TermVariant_typeApplication - TermVariantInject -> _TermVariant_inject - TermVariantUnit -> _TermVariant_unit - TermVariantUnwrap -> _TermVariant_unwrap - TermVariantVariable -> _TermVariant_variable - TermVariantWrap -> _TermVariant_wrap - --- | Convert a Haskell TypeVariant to a TypedTerm -typeVariant :: TypeVariant -> TypedTerm TypeVariant -typeVariant v = injectUnit _TypeVariant $ case v of - TypeVariantAnnotated -> _TypeVariant_annotated - TypeVariantApplication -> _TypeVariant_application - TypeVariantEither -> _TypeVariant_either - TypeVariantFunction -> _TypeVariant_function - TypeVariantForall -> _TypeVariant_forall - TypeVariantList -> _TypeVariant_list - TypeVariantLiteral -> _TypeVariant_literal - TypeVariantMap -> _TypeVariant_map - TypeVariantOptional -> _TypeVariant_optional - TypeVariantPair -> _TypeVariant_pair - TypeVariantRecord -> _TypeVariant_record - TypeVariantSet -> _TypeVariant_set - TypeVariantUnion -> _TypeVariant_union - TypeVariantUnit -> _TypeVariant_unit - TypeVariantVariable -> _TypeVariant_variable - TypeVariantVoid -> _TypeVariant_void - TypeVariantWrap -> _TypeVariant_wrap 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.packaging module Hydra.Dsl.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Typing as DslTyping @@ -10,6 +12,7 @@ import qualified Hydra.Typing as Typing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL injection for the primitive variant of hydra.packaging.Definition definitionPrimitive :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Packaging.Definition definitionPrimitive x = @@ -18,6 +21,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "primitive"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the primitive variant of hydra.packaging.DefinitionReference definitionReferencePrimitive :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.DefinitionReference definitionReferencePrimitive x = @@ -26,6 +30,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "primitive"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the term variant of hydra.packaging.DefinitionReference definitionReferenceTerm :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.DefinitionReference definitionReferenceTerm x = @@ -34,6 +39,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the type variant of hydra.packaging.DefinitionReference definitionReferenceType :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.DefinitionReference definitionReferenceType x = @@ -42,6 +48,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the term variant of hydra.packaging.Definition definitionTerm :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm Packaging.Definition definitionTerm x = @@ -50,6 +57,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the type variant of hydra.packaging.Definition definitionType :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm Packaging.Definition definitionType x = @@ -58,6 +66,43 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the api variant of hydra.packaging.DependencyScope +dependencyScopeApi :: Typed.TypedTerm Packaging.DependencyScope +dependencyScopeApi = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "api"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the runtime variant of hydra.packaging.DependencyScope +dependencyScopeRuntime :: Typed.TypedTerm Packaging.DependencyScope +dependencyScopeRuntime = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "runtime"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the test variant of hydra.packaging.DependencyScope +dependencyScopeTest :: Typed.TypedTerm Packaging.DependencyScope +dependencyScopeTest = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "test"), + Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the tool variant of hydra.packaging.DependencyScope +dependencyScopeTool :: Typed.TypedTerm Packaging.DependencyScope +dependencyScopeTool = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "tool"), + Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.packaging.EntityMetadata entityMetadata :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm [String] -> Typed.TypedTerm [Packaging.EntityReference] -> Typed.TypedTerm (Maybe Packaging.LifecycleInfo) -> Typed.TypedTerm Packaging.EntityMetadata entityMetadata description comments seeAlso lifecycle = @@ -76,6 +121,7 @@ Core.Field { Core.fieldName = (Core.Name "lifecycle"), Core.fieldTerm = (Typed.unTypedTerm lifecycle)}]})) + -- | DSL accessor for the comments field of hydra.packaging.EntityMetadata entityMetadataComments :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm [String] entityMetadataComments x = @@ -84,6 +130,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "comments")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the description field of hydra.packaging.EntityMetadata entityMetadataDescription :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm (Maybe String) entityMetadataDescription x = @@ -92,6 +139,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the lifecycle field of hydra.packaging.EntityMetadata entityMetadataLifecycle :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm (Maybe Packaging.LifecycleInfo) entityMetadataLifecycle x = @@ -100,6 +148,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "lifecycle")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the seeAlso field of hydra.packaging.EntityMetadata entityMetadataSeeAlso :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm [Packaging.EntityReference] entityMetadataSeeAlso x = @@ -108,6 +157,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "seeAlso")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the comments field of hydra.packaging.EntityMetadata entityMetadataWithComments :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm [String] -> Typed.TypedTerm Packaging.EntityMetadata entityMetadataWithComments original newVal = @@ -138,6 +188,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "lifecycle")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the description field of hydra.packaging.EntityMetadata entityMetadataWithDescription :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Packaging.EntityMetadata entityMetadataWithDescription original newVal = @@ -168,6 +219,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "lifecycle")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the lifecycle field of hydra.packaging.EntityMetadata entityMetadataWithLifecycle :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm (Maybe Packaging.LifecycleInfo) -> Typed.TypedTerm Packaging.EntityMetadata entityMetadataWithLifecycle original newVal = @@ -198,6 +250,7 @@ Core.Field { Core.fieldName = (Core.Name "lifecycle"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the seeAlso field of hydra.packaging.EntityMetadata entityMetadataWithSeeAlso :: Typed.TypedTerm Packaging.EntityMetadata -> Typed.TypedTerm [Packaging.EntityReference] -> Typed.TypedTerm Packaging.EntityMetadata entityMetadataWithSeeAlso original newVal = @@ -228,6 +281,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.EntityMetadata"), Core.projectionFieldName = (Core.Name "lifecycle")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the definition variant of hydra.packaging.EntityReference entityReferenceDefinition :: Typed.TypedTerm Packaging.DefinitionReference -> Typed.TypedTerm Packaging.EntityReference entityReferenceDefinition x = @@ -236,6 +290,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "definition"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the module variant of hydra.packaging.EntityReference entityReferenceModule :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.EntityReference entityReferenceModule x = @@ -244,6 +299,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "module"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the package variant of hydra.packaging.EntityReference entityReferencePackage :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm Packaging.EntityReference entityReferencePackage x = @@ -252,6 +308,25 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "package"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the termExpr variant of hydra.packaging.EntityReference +entityReferenceTermExpr :: Typed.TypedTerm String -> Typed.TypedTerm Packaging.EntityReference +entityReferenceTermExpr x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "termExpr"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the typeExpr variant of hydra.packaging.EntityReference +entityReferenceTypeExpr :: Typed.TypedTerm String -> Typed.TypedTerm Packaging.EntityReference +entityReferenceTypeExpr x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "typeExpr"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.packaging.LifecycleInfo lifecycleInfo :: Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.LifecycleInfo lifecycleInfo availableSince deprecatedSince = @@ -264,6 +339,7 @@ Core.Field { Core.fieldName = (Core.Name "deprecatedSince"), Core.fieldTerm = (Typed.unTypedTerm deprecatedSince)}]})) + -- | DSL accessor for the availableSince field of hydra.packaging.LifecycleInfo lifecycleInfoAvailableSince :: Typed.TypedTerm Packaging.LifecycleInfo -> Typed.TypedTerm (Maybe Packaging.Version) lifecycleInfoAvailableSince x = @@ -272,6 +348,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.LifecycleInfo"), Core.projectionFieldName = (Core.Name "availableSince")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the deprecatedSince field of hydra.packaging.LifecycleInfo lifecycleInfoDeprecatedSince :: Typed.TypedTerm Packaging.LifecycleInfo -> Typed.TypedTerm (Maybe Packaging.Version) lifecycleInfoDeprecatedSince x = @@ -280,6 +357,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.LifecycleInfo"), Core.projectionFieldName = (Core.Name "deprecatedSince")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -296,6 +374,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.LifecycleInfo"), Core.projectionFieldName = (Core.Name "deprecatedSince")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the deprecatedSince field of hydra.packaging.LifecycleInfo lifecycleInfoWithDeprecatedSince :: Typed.TypedTerm Packaging.LifecycleInfo -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.LifecycleInfo lifecycleInfoWithDeprecatedSince original newVal = @@ -312,6 +391,7 @@ Core.Field { Core.fieldName = (Core.Name "deprecatedSince"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.packaging.Module module_ :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm [Packaging.ModuleDependency] -> Typed.TypedTerm [Packaging.Definition] -> Typed.TypedTerm Packaging.Module module_ name metadata dependencies definitions = @@ -330,6 +410,7 @@ Core.Field { Core.fieldName = (Core.Name "definitions"), Core.fieldTerm = (Typed.unTypedTerm definitions)}]})) + -- | DSL accessor for the definitions field of hydra.packaging.Module moduleDefinitions :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm [Packaging.Definition] moduleDefinitions x = @@ -338,6 +419,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "definitions")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the dependencies field of hydra.packaging.Module moduleDependencies :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm [Packaging.ModuleDependency] moduleDependencies x = @@ -346,6 +428,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "dependencies")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.packaging.ModuleDependency moduleDependency :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm (Maybe Packaging.PackageName) -> Typed.TypedTerm Packaging.ModuleDependency moduleDependency module_ package = @@ -358,6 +441,7 @@ Core.Field { Core.fieldName = (Core.Name "package"), Core.fieldTerm = (Typed.unTypedTerm package)}]})) + -- | DSL accessor for the module field of hydra.packaging.ModuleDependency moduleDependencyModule :: Typed.TypedTerm Packaging.ModuleDependency -> Typed.TypedTerm Packaging.ModuleName moduleDependencyModule x = @@ -366,6 +450,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.ModuleDependency"), Core.projectionFieldName = (Core.Name "module")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the package field of hydra.packaging.ModuleDependency moduleDependencyPackage :: Typed.TypedTerm Packaging.ModuleDependency -> Typed.TypedTerm (Maybe Packaging.PackageName) moduleDependencyPackage x = @@ -374,6 +459,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.ModuleDependency"), Core.projectionFieldName = (Core.Name "package")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the module field of hydra.packaging.ModuleDependency moduleDependencyWithModule :: Typed.TypedTerm Packaging.ModuleDependency -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.ModuleDependency moduleDependencyWithModule original newVal = @@ -390,6 +476,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.ModuleDependency"), Core.projectionFieldName = (Core.Name "package")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the package field of hydra.packaging.ModuleDependency moduleDependencyWithPackage :: Typed.TypedTerm Packaging.ModuleDependency -> Typed.TypedTerm (Maybe Packaging.PackageName) -> Typed.TypedTerm Packaging.ModuleDependency moduleDependencyWithPackage original newVal = @@ -406,6 +493,7 @@ Core.Field { Core.fieldName = (Core.Name "package"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL accessor for the metadata field of hydra.packaging.Module moduleMetadata :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) moduleMetadata x = @@ -414,6 +502,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.packaging.Module moduleName :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Packaging.ModuleName moduleName x = @@ -422,12 +511,14 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.packaging.ModuleName wrapper moduleName2 :: Typed.TypedTerm String -> Typed.TypedTerm Packaging.ModuleName moduleName2 x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.ModuleName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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 = @@ -458,6 +549,7 @@ Core.Field { Core.fieldName = (Core.Name "definitions"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the dependencies field of hydra.packaging.Module moduleWithDependencies :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm [Packaging.ModuleDependency] -> Typed.TypedTerm Packaging.Module moduleWithDependencies original newVal = @@ -488,6 +580,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "definitions")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the metadata field of hydra.packaging.Module moduleWithMetadata :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Packaging.Module moduleWithMetadata original newVal = @@ -518,6 +611,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "definitions")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.packaging.Module moduleWithName :: Typed.TypedTerm Packaging.Module -> Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm Packaging.Module moduleWithName original newVal = @@ -548,6 +642,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Module"), Core.projectionFieldName = (Core.Name "definitions")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.packaging.Package package :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm [Packaging.PackageDependency] -> Typed.TypedTerm [Packaging.Module] -> Typed.TypedTerm Packaging.Package package name metadata dependencies modules = @@ -566,6 +661,7 @@ Core.Field { Core.fieldName = (Core.Name "modules"), Core.fieldTerm = (Typed.unTypedTerm modules)}]})) + -- | DSL accessor for the dependencies field of hydra.packaging.Package packageDependencies :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm [Packaging.PackageDependency] packageDependencies x = @@ -574,9 +670,10 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "dependencies")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.packaging.PackageDependency -packageDependency :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm Packaging.VersionSpecifier -> Typed.TypedTerm Packaging.PackageDependency -packageDependency name version = +packageDependency :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm Packaging.VersionSpecifier -> Typed.TypedTerm (Maybe Packaging.DependencyScope) -> Typed.TypedTerm Packaging.PackageDependency +packageDependency name version scope = Typed.TypedTerm (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.packaging.PackageDependency"), Core.recordFields = [ @@ -585,7 +682,11 @@ Core.fieldTerm = (Typed.unTypedTerm name)}, Core.Field { Core.fieldName = (Core.Name "version"), - Core.fieldTerm = (Typed.unTypedTerm version)}]})) + Core.fieldTerm = (Typed.unTypedTerm version)}, + Core.Field { + Core.fieldName = (Core.Name "scope"), + Core.fieldTerm = (Typed.unTypedTerm scope)}]})) + -- | DSL accessor for the name field of hydra.packaging.PackageDependency packageDependencyName :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm Packaging.PackageName packageDependencyName x = @@ -594,6 +695,16 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the scope field of hydra.packaging.PackageDependency +packageDependencyScope :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm (Maybe Packaging.DependencyScope) +packageDependencyScope x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.projectionFieldName = (Core.Name "scope")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the version field of hydra.packaging.PackageDependency packageDependencyVersion :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm Packaging.VersionSpecifier packageDependencyVersion x = @@ -602,6 +713,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), Core.projectionFieldName = (Core.Name "version")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.packaging.PackageDependency packageDependencyWithName :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm Packaging.PackageDependency packageDependencyWithName original newVal = @@ -617,7 +729,39 @@ Core.applicationFunction = (Core.TermProject (Core.Projection { Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), Core.projectionFieldName = (Core.Name "version")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "scope"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.projectionFieldName = (Core.Name "scope")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the scope field of hydra.packaging.PackageDependency +packageDependencyWithScope :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm (Maybe Packaging.DependencyScope) -> Typed.TypedTerm Packaging.PackageDependency +packageDependencyWithScope original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "name"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.projectionFieldName = (Core.Name "name")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "version"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.projectionFieldName = (Core.Name "version")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "scope"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the version field of hydra.packaging.PackageDependency packageDependencyWithVersion :: Typed.TypedTerm Packaging.PackageDependency -> Typed.TypedTerm Packaging.VersionSpecifier -> Typed.TypedTerm Packaging.PackageDependency packageDependencyWithVersion original newVal = @@ -633,7 +777,15 @@ Core.applicationArgument = (Typed.unTypedTerm original)}))}, Core.Field { Core.fieldName = (Core.Name "version"), - Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "scope"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.PackageDependency"), + Core.projectionFieldName = (Core.Name "scope")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the metadata field of hydra.packaging.Package packageMetadata :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) packageMetadata x = @@ -642,6 +794,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the modules field of hydra.packaging.Package packageModules :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm [Packaging.Module] packageModules x = @@ -650,6 +803,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "modules")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.packaging.Package packageName :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm Packaging.PackageName packageName x = @@ -658,12 +812,14 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.packaging.PackageName wrapper packageName2 :: Typed.TypedTerm String -> Typed.TypedTerm Packaging.PackageName packageName2 x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.PackageName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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 = @@ -694,6 +850,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "modules")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the metadata field of hydra.packaging.Package packageWithMetadata :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Packaging.Package packageWithMetadata original newVal = @@ -724,6 +881,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "modules")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the modules field of hydra.packaging.Package packageWithModules :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm [Packaging.Module] -> Typed.TypedTerm Packaging.Package packageWithModules original newVal = @@ -754,6 +912,7 @@ Core.Field { Core.fieldName = (Core.Name "modules"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.packaging.Package packageWithName :: Typed.TypedTerm Packaging.Package -> Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm Packaging.Package packageWithName original newVal = @@ -784,6 +943,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.Package"), Core.projectionFieldName = (Core.Name "modules")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.packaging.PrimitiveDefinition primitiveDefinition :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm Bool -> Typed.TypedTerm Bool -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinition name metadata signature isPure isTotal defaultImplementation = @@ -808,6 +968,7 @@ Core.Field { Core.fieldName = (Core.Name "defaultImplementation"), Core.fieldTerm = (Typed.unTypedTerm defaultImplementation)}]})) + -- | DSL accessor for the defaultImplementation field of hydra.packaging.PrimitiveDefinition primitiveDefinitionDefaultImplementation :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm (Maybe Core.Term) primitiveDefinitionDefaultImplementation x = @@ -816,6 +977,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the isPure field of hydra.packaging.PrimitiveDefinition primitiveDefinitionIsPure :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Bool primitiveDefinitionIsPure x = @@ -824,6 +986,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "isPure")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the isTotal field of hydra.packaging.PrimitiveDefinition primitiveDefinitionIsTotal :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Bool primitiveDefinitionIsTotal x = @@ -832,6 +995,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "isTotal")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the metadata field of hydra.packaging.PrimitiveDefinition primitiveDefinitionMetadata :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) primitiveDefinitionMetadata x = @@ -840,6 +1004,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.packaging.PrimitiveDefinition primitiveDefinitionName :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Core.Name primitiveDefinitionName x = @@ -848,6 +1013,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the signature field of hydra.packaging.PrimitiveDefinition primitiveDefinitionSignature :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Typing.TermSignature primitiveDefinitionSignature x = @@ -856,6 +1022,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "signature")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the defaultImplementation field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithDefaultImplementation :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm (Maybe Core.Term) -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithDefaultImplementation original newVal = @@ -900,6 +1067,7 @@ Core.Field { Core.fieldName = (Core.Name "defaultImplementation"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the isPure field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithIsPure :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Bool -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithIsPure original newVal = @@ -944,6 +1112,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the isTotal field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithIsTotal :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Bool -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithIsTotal original newVal = @@ -988,6 +1157,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the metadata field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithMetadata :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithMetadata original newVal = @@ -1032,6 +1202,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithName :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithName original newVal = @@ -1076,6 +1247,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the signature field of hydra.packaging.PrimitiveDefinition primitiveDefinitionWithSignature :: Typed.TypedTerm Packaging.PrimitiveDefinition -> Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm Packaging.PrimitiveDefinition primitiveDefinitionWithSignature original newVal = @@ -1120,6 +1292,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.PrimitiveDefinition"), Core.projectionFieldName = (Core.Name "defaultImplementation")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.packaging.TermDefinition termDefinition :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm (Maybe Typing.TermSignature) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Packaging.TermDefinition termDefinition name metadata signature body = @@ -1138,6 +1311,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.packaging.TermDefinition termDefinitionBody :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm Core.Term termDefinitionBody x = @@ -1146,6 +1320,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the metadata field of hydra.packaging.TermDefinition termDefinitionMetadata :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) termDefinitionMetadata x = @@ -1154,6 +1329,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.packaging.TermDefinition termDefinitionName :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm Core.Name termDefinitionName x = @@ -1162,6 +1338,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the signature field of hydra.packaging.TermDefinition termDefinitionSignature :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm (Maybe Typing.TermSignature) termDefinitionSignature x = @@ -1170,6 +1347,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "signature")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1200,6 +1378,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the metadata field of hydra.packaging.TermDefinition termDefinitionWithMetadata :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Packaging.TermDefinition termDefinitionWithMetadata original newVal = @@ -1230,6 +1409,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.packaging.TermDefinition termDefinitionWithName :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.TermDefinition termDefinitionWithName original newVal = @@ -1260,6 +1440,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the signature field of hydra.packaging.TermDefinition termDefinitionWithSignature :: Typed.TypedTerm Packaging.TermDefinition -> Typed.TypedTerm (Maybe Typing.TermSignature) -> Typed.TypedTerm Packaging.TermDefinition termDefinitionWithSignature original newVal = @@ -1290,6 +1471,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TermDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.packaging.TypeDefinition typeDefinition :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Core.TypeScheme -> Typed.TypedTerm Packaging.TypeDefinition typeDefinition name metadata body = @@ -1305,6 +1487,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm body)}]})) + -- | DSL accessor for the body field of hydra.packaging.TypeDefinition typeDefinitionBody :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm Core.TypeScheme typeDefinitionBody x = @@ -1313,6 +1496,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TypeDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the metadata field of hydra.packaging.TypeDefinition typeDefinitionMetadata :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) typeDefinitionMetadata x = @@ -1321,6 +1505,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TypeDefinition"), Core.projectionFieldName = (Core.Name "metadata")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.packaging.TypeDefinition typeDefinitionName :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm Core.Name typeDefinitionName x = @@ -1329,6 +1514,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TypeDefinition"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1352,6 +1538,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the metadata field of hydra.packaging.TypeDefinition typeDefinitionWithMetadata :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm (Maybe Packaging.EntityMetadata) -> Typed.TypedTerm Packaging.TypeDefinition typeDefinitionWithMetadata original newVal = @@ -1375,6 +1562,7 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TypeDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.packaging.TypeDefinition typeDefinitionWithName :: Typed.TypedTerm Packaging.TypeDefinition -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Packaging.TypeDefinition typeDefinitionWithName original newVal = @@ -1398,30 +1586,100 @@ Core.projectionTypeName = (Core.Name "hydra.packaging.TypeDefinition"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the body of hydra.packaging.ModuleName unModuleName :: Typed.TypedTerm Packaging.ModuleName -> Typed.TypedTerm String unModuleName x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.packaging.ModuleName")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.packaging.PackageName unPackageName :: Typed.TypedTerm Packaging.PackageName -> Typed.TypedTerm String unPackageName x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.packaging.PackageName")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.packaging.Version unVersion :: Typed.TypedTerm Packaging.Version -> Typed.TypedTerm String unVersion x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.packaging.Version")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.packaging.Version wrapper version :: Typed.TypedTerm String -> Typed.TypedTerm Packaging.Version version x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.Version"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL constructor for hydra.packaging.VersionRange +versionRange :: Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.VersionRange +versionRange lowerInclusive upperExclusive = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "lowerInclusive"), + Core.fieldTerm = (Typed.unTypedTerm lowerInclusive)}, + Core.Field { + Core.fieldName = (Core.Name "upperExclusive"), + Core.fieldTerm = (Typed.unTypedTerm upperExclusive)}]})) + +-- | DSL accessor for the lowerInclusive field of hydra.packaging.VersionRange +versionRangeLowerInclusive :: Typed.TypedTerm Packaging.VersionRange -> Typed.TypedTerm (Maybe Packaging.Version) +versionRangeLowerInclusive x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.projectionFieldName = (Core.Name "lowerInclusive")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the upperExclusive field of hydra.packaging.VersionRange +versionRangeUpperExclusive :: Typed.TypedTerm Packaging.VersionRange -> Typed.TypedTerm (Maybe Packaging.Version) +versionRangeUpperExclusive x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.projectionFieldName = (Core.Name "upperExclusive")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | 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 = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "lowerInclusive"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "upperExclusive"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.projectionFieldName = (Core.Name "upperExclusive")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the upperExclusive field of hydra.packaging.VersionRange +versionRangeWithUpperExclusive :: Typed.TypedTerm Packaging.VersionRange -> Typed.TypedTerm (Maybe Packaging.Version) -> Typed.TypedTerm Packaging.VersionRange +versionRangeWithUpperExclusive original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "lowerInclusive"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.projectionFieldName = (Core.Name "lowerInclusive")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "upperExclusive"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the any variant of hydra.packaging.VersionSpecifier versionSpecifierAny :: Typed.TypedTerm Packaging.VersionSpecifier versionSpecifierAny = @@ -1430,3 +1688,30 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "any"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the atLeast variant of hydra.packaging.VersionSpecifier +versionSpecifierAtLeast :: Typed.TypedTerm Packaging.Version -> Typed.TypedTerm Packaging.VersionSpecifier +versionSpecifierAtLeast x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "atLeast"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the exact variant of hydra.packaging.VersionSpecifier +versionSpecifierExact :: Typed.TypedTerm Packaging.Version -> Typed.TypedTerm Packaging.VersionSpecifier +versionSpecifierExact x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "exact"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the range variant of hydra.packaging.VersionSpecifier +versionSpecifierRange :: Typed.TypedTerm Packaging.VersionRange -> Typed.TypedTerm Packaging.VersionSpecifier +versionSpecifierRange x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.parsing module Hydra.Dsl.Parsing where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore 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 constructor for hydra.parsing.ParseError parseError :: Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Parsing.ParseError parseError message remainder = @@ -20,6 +23,7 @@ Core.Field { Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = (Typed.unTypedTerm remainder)}]})) + -- | DSL accessor for the message field of hydra.parsing.ParseError parseErrorMessage :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm String parseErrorMessage x = @@ -28,6 +32,7 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseError"), Core.projectionFieldName = (Core.Name "message")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the remainder field of hydra.parsing.ParseError parseErrorRemainder :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm String parseErrorRemainder x = @@ -36,6 +41,7 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseError"), Core.projectionFieldName = (Core.Name "remainder")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the message field of hydra.parsing.ParseError parseErrorWithMessage :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm String -> Typed.TypedTerm Parsing.ParseError parseErrorWithMessage original newVal = @@ -52,6 +58,7 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseError"), Core.projectionFieldName = (Core.Name "remainder")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the remainder field of hydra.parsing.ParseError parseErrorWithRemainder :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm String -> Typed.TypedTerm Parsing.ParseError parseErrorWithRemainder original newVal = @@ -68,6 +75,7 @@ Core.Field { Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the failure variant of hydra.parsing.ParseResult parseResultFailure :: Typed.TypedTerm Parsing.ParseError -> Typed.TypedTerm (Parsing.ParseResult a) parseResultFailure x = @@ -76,6 +84,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "failure"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the success variant of hydra.parsing.ParseResult parseResultSuccess :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm (Parsing.ParseResult a) parseResultSuccess x = @@ -84,6 +93,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "success"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.parsing.ParseSuccess parseSuccess :: Typed.TypedTerm a -> Typed.TypedTerm String -> Typed.TypedTerm (Parsing.ParseSuccess a) parseSuccess value remainder = @@ -96,6 +106,7 @@ Core.Field { Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = (Typed.unTypedTerm remainder)}]})) + -- | DSL accessor for the remainder field of hydra.parsing.ParseSuccess parseSuccessRemainder :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm String parseSuccessRemainder x = @@ -104,6 +115,7 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseSuccess"), Core.projectionFieldName = (Core.Name "remainder")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the value field of hydra.parsing.ParseSuccess parseSuccessValue :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm a parseSuccessValue x = @@ -112,6 +124,7 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseSuccess"), Core.projectionFieldName = (Core.Name "value")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the remainder field of hydra.parsing.ParseSuccess parseSuccessWithRemainder :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm String -> Typed.TypedTerm (Parsing.ParseSuccess a) parseSuccessWithRemainder original newVal = @@ -128,6 +141,7 @@ Core.Field { Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the value field of hydra.parsing.ParseSuccess parseSuccessWithValue :: Typed.TypedTerm (Parsing.ParseSuccess a) -> Typed.TypedTerm a -> Typed.TypedTerm (Parsing.ParseSuccess a) parseSuccessWithValue original newVal = @@ -144,12 +158,14 @@ Core.projectionTypeName = (Core.Name "hydra.parsing.ParseSuccess"), Core.projectionFieldName = (Core.Name "remainder")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.parsing.Parser wrapper parser :: Typed.TypedTerm (String -> Parsing.ParseResult a) -> Typed.TypedTerm (Parsing.Parser a) parser x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.parsing.Parser"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.parsing.Parser unParser :: Typed.TypedTerm (Parsing.Parser a) -> Typed.TypedTerm (String -> Parsing.ParseResult a) unParser x = 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.paths module Hydra.Dsl.Paths where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Paths as Paths import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL constructor for hydra.paths.SubtermEdge subtermEdge :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Paths.SubtermEdge subtermEdge source path target = @@ -23,6 +26,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (Typed.unTypedTerm target)}]})) + -- | DSL accessor for the path field of hydra.paths.SubtermEdge subtermEdgePath :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermPath subtermEdgePath x = @@ -31,6 +35,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermEdge"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the source field of hydra.paths.SubtermEdge subtermEdgeSource :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermNode subtermEdgeSource x = @@ -39,6 +44,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermEdge"), Core.projectionFieldName = (Core.Name "source")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the target field of hydra.paths.SubtermEdge subtermEdgeTarget :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermNode subtermEdgeTarget x = @@ -47,6 +53,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the path field of hydra.paths.SubtermEdge subtermEdgeWithPath :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Paths.SubtermEdge subtermEdgeWithPath original newVal = @@ -70,6 +77,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the source field of hydra.paths.SubtermEdge subtermEdgeWithSource :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Paths.SubtermEdge subtermEdgeWithSource original newVal = @@ -93,6 +101,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the target field of hydra.paths.SubtermEdge subtermEdgeWithTarget :: Typed.TypedTerm Paths.SubtermEdge -> Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Paths.SubtermEdge subtermEdgeWithTarget original newVal = @@ -116,6 +125,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.paths.SubtermGraph subtermGraph :: Typed.TypedTerm [Paths.SubtermNode] -> Typed.TypedTerm [Paths.SubtermEdge] -> Typed.TypedTerm Paths.SubtermGraph subtermGraph nodes edges = @@ -128,6 +138,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = (Typed.unTypedTerm edges)}]})) + -- | DSL accessor for the edges field of hydra.paths.SubtermGraph subtermGraphEdges :: Typed.TypedTerm Paths.SubtermGraph -> Typed.TypedTerm [Paths.SubtermEdge] subtermGraphEdges x = @@ -136,6 +147,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermGraph"), Core.projectionFieldName = (Core.Name "edges")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the nodes field of hydra.paths.SubtermGraph subtermGraphNodes :: Typed.TypedTerm Paths.SubtermGraph -> Typed.TypedTerm [Paths.SubtermNode] subtermGraphNodes x = @@ -144,6 +156,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermGraph"), Core.projectionFieldName = (Core.Name "nodes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -160,6 +173,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the nodes field of hydra.paths.SubtermGraph subtermGraphWithNodes :: Typed.TypedTerm Paths.SubtermGraph -> Typed.TypedTerm [Paths.SubtermNode] -> Typed.TypedTerm Paths.SubtermGraph subtermGraphWithNodes original newVal = @@ -176,6 +190,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermGraph"), Core.projectionFieldName = (Core.Name "edges")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.paths.SubtermNode subtermNode :: Typed.TypedTerm Core.Name -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtermNode subtermNode name label id = @@ -191,6 +206,7 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = (Typed.unTypedTerm id)}]})) + -- | DSL accessor for the id field of hydra.paths.SubtermNode subtermNodeId :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm String subtermNodeId x = @@ -199,6 +215,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the label field of hydra.paths.SubtermNode subtermNodeLabel :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm String subtermNodeLabel x = @@ -207,6 +224,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermNode"), Core.projectionFieldName = (Core.Name "label")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.paths.SubtermNode subtermNodeName :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Core.Name subtermNodeName x = @@ -215,6 +233,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermNode"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -238,6 +257,7 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the label field of hydra.paths.SubtermNode subtermNodeWithLabel :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtermNode subtermNodeWithLabel original newVal = @@ -261,6 +281,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.paths.SubtermNode subtermNodeWithName :: Typed.TypedTerm Paths.SubtermNode -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtermNode subtermNodeWithName original newVal = @@ -284,12 +305,14 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtermNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.paths.SubtermPath wrapper subtermPath :: Typed.TypedTerm [Paths.SubtermStep] -> Typed.TypedTerm Paths.SubtermPath subtermPath x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtermPath"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL injection for the annotatedBody variant of hydra.paths.SubtermStep subtermStepAnnotatedBody :: Typed.TypedTerm Paths.SubtermStep subtermStepAnnotatedBody = @@ -298,6 +321,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotatedBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the applicationArgument variant of hydra.paths.SubtermStep subtermStepApplicationArgument :: Typed.TypedTerm Paths.SubtermStep subtermStepApplicationArgument = @@ -306,6 +330,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "applicationArgument"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the applicationFunction variant of hydra.paths.SubtermStep subtermStepApplicationFunction :: Typed.TypedTerm Paths.SubtermStep subtermStepApplicationFunction = @@ -314,6 +339,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "applicationFunction"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the injectionTerm variant of hydra.paths.SubtermStep subtermStepInjectionTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepInjectionTerm = @@ -322,6 +348,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "injectionTerm"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lambdaBody variant of hydra.paths.SubtermStep subtermStepLambdaBody :: Typed.TypedTerm Paths.SubtermStep subtermStepLambdaBody = @@ -330,6 +357,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lambdaBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the letBinding variant of hydra.paths.SubtermStep subtermStepLetBinding :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtermStep subtermStepLetBinding x = @@ -338,6 +366,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "letBinding"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the letBody variant of hydra.paths.SubtermStep subtermStepLetBody :: Typed.TypedTerm Paths.SubtermStep subtermStepLetBody = @@ -346,6 +375,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "letBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the listElement variant of hydra.paths.SubtermStep subtermStepListElement :: Typed.TypedTerm Int -> Typed.TypedTerm Paths.SubtermStep subtermStepListElement x = @@ -354,6 +384,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "listElement"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the mapKey variant of hydra.paths.SubtermStep subtermStepMapKey :: Typed.TypedTerm Int -> Typed.TypedTerm Paths.SubtermStep subtermStepMapKey x = @@ -362,6 +393,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "mapKey"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the mapValue variant of hydra.paths.SubtermStep subtermStepMapValue :: Typed.TypedTerm Int -> Typed.TypedTerm Paths.SubtermStep subtermStepMapValue x = @@ -370,6 +402,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "mapValue"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the optionalTerm variant of hydra.paths.SubtermStep subtermStepOptionalTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepOptionalTerm = @@ -378,6 +411,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optionalTerm"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the productTerm variant of hydra.paths.SubtermStep subtermStepProductTerm :: Typed.TypedTerm Int -> Typed.TypedTerm Paths.SubtermStep subtermStepProductTerm x = @@ -386,6 +420,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "productTerm"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the recordField variant of hydra.paths.SubtermStep subtermStepRecordField :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtermStep subtermStepRecordField x = @@ -394,6 +429,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "recordField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the setElement variant of hydra.paths.SubtermStep subtermStepSetElement :: Typed.TypedTerm Int -> Typed.TypedTerm Paths.SubtermStep subtermStepSetElement x = @@ -402,6 +438,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "setElement"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the sumTerm variant of hydra.paths.SubtermStep subtermStepSumTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepSumTerm = @@ -410,6 +447,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "sumTerm"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the typeApplicationTerm variant of hydra.paths.SubtermStep subtermStepTypeApplicationTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepTypeApplicationTerm = @@ -418,6 +456,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeApplicationTerm"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the typeLambdaBody variant of hydra.paths.SubtermStep subtermStepTypeLambdaBody :: Typed.TypedTerm Paths.SubtermStep subtermStepTypeLambdaBody = @@ -426,6 +465,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeLambdaBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unionCasesBranch variant of hydra.paths.SubtermStep subtermStepUnionCasesBranch :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtermStep subtermStepUnionCasesBranch x = @@ -434,6 +474,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unionCasesBranch"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the unionCasesDefault variant of hydra.paths.SubtermStep subtermStepUnionCasesDefault :: Typed.TypedTerm Paths.SubtermStep subtermStepUnionCasesDefault = @@ -442,6 +483,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unionCasesDefault"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the wrappedTerm variant of hydra.paths.SubtermStep subtermStepWrappedTerm :: Typed.TypedTerm Paths.SubtermStep subtermStepWrappedTerm = @@ -450,6 +492,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrappedTerm"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.paths.SubtypeEdge subtypeEdge :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Paths.SubtypePath -> Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Paths.SubtypeEdge subtypeEdge source path target = @@ -465,6 +508,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (Typed.unTypedTerm target)}]})) + -- | DSL accessor for the path field of hydra.paths.SubtypeEdge subtypeEdgePath :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypePath subtypeEdgePath x = @@ -473,6 +517,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeEdge"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the source field of hydra.paths.SubtypeEdge subtypeEdgeSource :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypeNode subtypeEdgeSource x = @@ -481,6 +526,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeEdge"), Core.projectionFieldName = (Core.Name "source")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the target field of hydra.paths.SubtypeEdge subtypeEdgeTarget :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypeNode subtypeEdgeTarget x = @@ -489,6 +535,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the path field of hydra.paths.SubtypeEdge subtypeEdgeWithPath :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypePath -> Typed.TypedTerm Paths.SubtypeEdge subtypeEdgeWithPath original newVal = @@ -512,6 +559,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the source field of hydra.paths.SubtypeEdge subtypeEdgeWithSource :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Paths.SubtypeEdge subtypeEdgeWithSource original newVal = @@ -535,6 +583,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeEdge"), Core.projectionFieldName = (Core.Name "target")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the target field of hydra.paths.SubtypeEdge subtypeEdgeWithTarget :: Typed.TypedTerm Paths.SubtypeEdge -> Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Paths.SubtypeEdge subtypeEdgeWithTarget original newVal = @@ -558,6 +607,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.paths.SubtypeGraph subtypeGraph :: Typed.TypedTerm [Paths.SubtypeNode] -> Typed.TypedTerm [Paths.SubtypeEdge] -> Typed.TypedTerm Paths.SubtypeGraph subtypeGraph nodes edges = @@ -570,6 +620,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = (Typed.unTypedTerm edges)}]})) + -- | DSL accessor for the edges field of hydra.paths.SubtypeGraph subtypeGraphEdges :: Typed.TypedTerm Paths.SubtypeGraph -> Typed.TypedTerm [Paths.SubtypeEdge] subtypeGraphEdges x = @@ -578,6 +629,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeGraph"), Core.projectionFieldName = (Core.Name "edges")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the nodes field of hydra.paths.SubtypeGraph subtypeGraphNodes :: Typed.TypedTerm Paths.SubtypeGraph -> Typed.TypedTerm [Paths.SubtypeNode] subtypeGraphNodes x = @@ -586,6 +638,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeGraph"), Core.projectionFieldName = (Core.Name "nodes")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -602,6 +655,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the nodes field of hydra.paths.SubtypeGraph subtypeGraphWithNodes :: Typed.TypedTerm Paths.SubtypeGraph -> Typed.TypedTerm [Paths.SubtypeNode] -> Typed.TypedTerm Paths.SubtypeGraph subtypeGraphWithNodes original newVal = @@ -618,6 +672,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeGraph"), Core.projectionFieldName = (Core.Name "edges")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.paths.SubtypeNode subtypeNode :: Typed.TypedTerm Core.Name -> Typed.TypedTerm String -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtypeNode subtypeNode name label id = @@ -633,6 +688,7 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = (Typed.unTypedTerm id)}]})) + -- | DSL accessor for the id field of hydra.paths.SubtypeNode subtypeNodeId :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm String subtypeNodeId x = @@ -641,6 +697,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the label field of hydra.paths.SubtypeNode subtypeNodeLabel :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm String subtypeNodeLabel x = @@ -649,6 +706,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeNode"), Core.projectionFieldName = (Core.Name "label")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.paths.SubtypeNode subtypeNodeName :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Core.Name subtypeNodeName x = @@ -657,6 +715,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeNode"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -680,6 +739,7 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the label field of hydra.paths.SubtypeNode subtypeNodeWithLabel :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm String -> Typed.TypedTerm Paths.SubtypeNode subtypeNodeWithLabel original newVal = @@ -703,6 +763,7 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.paths.SubtypeNode subtypeNodeWithName :: Typed.TypedTerm Paths.SubtypeNode -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtypeNode subtypeNodeWithName original newVal = @@ -726,12 +787,14 @@ Core.projectionTypeName = (Core.Name "hydra.paths.SubtypeNode"), Core.projectionFieldName = (Core.Name "id")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.paths.SubtypePath wrapper subtypePath :: Typed.TypedTerm [Paths.SubtypeStep] -> Typed.TypedTerm Paths.SubtypePath subtypePath x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtypePath"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL injection for the annotatedBody variant of hydra.paths.SubtypeStep subtypeStepAnnotatedBody :: Typed.TypedTerm Paths.SubtypeStep subtypeStepAnnotatedBody = @@ -740,6 +803,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotatedBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the applicationArgument variant of hydra.paths.SubtypeStep subtypeStepApplicationArgument :: Typed.TypedTerm Paths.SubtypeStep subtypeStepApplicationArgument = @@ -748,6 +812,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "applicationArgument"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the applicationFunction variant of hydra.paths.SubtypeStep subtypeStepApplicationFunction :: Typed.TypedTerm Paths.SubtypeStep subtypeStepApplicationFunction = @@ -756,6 +821,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "applicationFunction"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the eitherLeft variant of hydra.paths.SubtypeStep subtypeStepEitherLeft :: Typed.TypedTerm Paths.SubtypeStep subtypeStepEitherLeft = @@ -764,6 +830,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "eitherLeft"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the eitherRight variant of hydra.paths.SubtypeStep subtypeStepEitherRight :: Typed.TypedTerm Paths.SubtypeStep subtypeStepEitherRight = @@ -772,6 +839,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "eitherRight"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the forallBody variant of hydra.paths.SubtypeStep subtypeStepForallBody :: Typed.TypedTerm Paths.SubtypeStep subtypeStepForallBody = @@ -780,6 +848,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "forallBody"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the functionCodomain variant of hydra.paths.SubtypeStep subtypeStepFunctionCodomain :: Typed.TypedTerm Paths.SubtypeStep subtypeStepFunctionCodomain = @@ -788,6 +857,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "functionCodomain"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the functionDomain variant of hydra.paths.SubtypeStep subtypeStepFunctionDomain :: Typed.TypedTerm Paths.SubtypeStep subtypeStepFunctionDomain = @@ -796,6 +866,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "functionDomain"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the listElement variant of hydra.paths.SubtypeStep subtypeStepListElement :: Typed.TypedTerm Paths.SubtypeStep subtypeStepListElement = @@ -804,6 +875,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "listElement"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the mapKeys variant of hydra.paths.SubtypeStep subtypeStepMapKeys :: Typed.TypedTerm Paths.SubtypeStep subtypeStepMapKeys = @@ -812,6 +884,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "mapKeys"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the mapValues variant of hydra.paths.SubtypeStep subtypeStepMapValues :: Typed.TypedTerm Paths.SubtypeStep subtypeStepMapValues = @@ -820,6 +893,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "mapValues"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the optionalElement variant of hydra.paths.SubtypeStep subtypeStepOptionalElement :: Typed.TypedTerm Paths.SubtypeStep subtypeStepOptionalElement = @@ -828,6 +902,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optionalElement"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pairFirst variant of hydra.paths.SubtypeStep subtypeStepPairFirst :: Typed.TypedTerm Paths.SubtypeStep subtypeStepPairFirst = @@ -836,6 +911,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pairFirst"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pairSecond variant of hydra.paths.SubtypeStep subtypeStepPairSecond :: Typed.TypedTerm Paths.SubtypeStep subtypeStepPairSecond = @@ -844,6 +920,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pairSecond"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the recordField variant of hydra.paths.SubtypeStep subtypeStepRecordField :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtypeStep subtypeStepRecordField x = @@ -852,6 +929,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "recordField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the setElement variant of hydra.paths.SubtypeStep subtypeStepSetElement :: Typed.TypedTerm Paths.SubtypeStep subtypeStepSetElement = @@ -860,6 +938,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "setElement"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unionField variant of hydra.paths.SubtypeStep subtypeStepUnionField :: Typed.TypedTerm Core.Name -> Typed.TypedTerm Paths.SubtypeStep subtypeStepUnionField x = @@ -868,6 +947,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unionField"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the wrappedType variant of hydra.paths.SubtypeStep subtypeStepWrappedType :: Typed.TypedTerm Paths.SubtypeStep subtypeStepWrappedType = @@ -876,12 +956,14 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrappedType"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL accessor for the body of hydra.paths.SubtermPath unSubtermPath :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm [Paths.SubtermStep] unSubtermPath x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.paths.SubtermPath")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.paths.SubtypePath unSubtypePath :: Typed.TypedTerm Paths.SubtypePath -> Typed.TypedTerm [Paths.SubtypeStep] unSubtypePath x = diff --git a/src/main/haskell/Hydra/Dsl/Prims.hs b/src/main/haskell/Hydra/Dsl/Prims.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Prims.hs +++ /dev/null @@ -1,435 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -- for IsString with nontrivial parameters - --- | A DSL for constructing primitive function definitions -module Hydra.Dsl.Prims where - -import Hydra.Core -import Hydra.Graph -import Hydra.Packaging -import Hydra.Scoping (typeSchemeToTermSignature) -import Hydra.Util -import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Decode.Core as DecodeCore -import qualified Hydra.Extract.Core as ExtractCore -import qualified Hydra.Typing as Typing -import qualified Hydra.Errors as Error -import qualified Hydra.Extract.Util as ExtractUtil -import qualified Hydra.Dsl.Terms as Terms -import Hydra.Dsl.Terms (ToPrimName(..)) -import qualified Hydra.Dsl.Types as Types -import qualified Hydra.Show.Core as ShowCore - -import Data.Int -import qualified Data.ByteString as B -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Scientific as Sci -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Hydra.Strip (removeTermAnnotations) -import Hydra.Lexical (emptyInferenceContext) -import Data.String(IsString(..)) -import Data.Either (Either) - --- | Placeholder InferenceContext for the TermCoder encode/decode machinery used inside the prim* --- wrappers. Since #446, a Primitive's implementation carrier no longer threads the InferenceContext: --- coders use it only for error context (otherErr ignores it) and decode (which doesn't consult it), --- so an empty cx is sufficient and correct. The Graph, by contrast, is still threaded through the --- carrier and passed to the coders, because the higher-order primitives that evaluate a function --- argument (via functionWithReduce) need the live graph to resolve primitive names. -primCx :: Typing.InferenceContext -primCx = emptyInferenceContext - -bigint :: TermCoder Integer -bigint = TermCoder Types.bigint encode decode - where - encode _cx g = ExtractCore.bigint g - decode _cx = Right . Terms.bigint - -binary :: TermCoder B.ByteString -binary = TermCoder Types.binary encode decode - where - encode _cx g = ExtractCore.binary g - decode _cx = Right . Terms.binary - -boolean :: TermCoder Bool -boolean = TermCoder Types.boolean encode decode - where - 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 -comparison = TermCoder (TypeVariable _Comparison) encode decode - where - encode _cx g = ExtractUtil.comparison _cx g - decode _cx = Right . Terms.comparison - -decimal :: TermCoder Sci.Scientific -decimal = TermCoder Types.decimal encode decode - where - encode _cx g = ExtractCore.decimal g - decode _cx = Right . Terms.decimal - --- | The qualified name of a primitive, read from its PrimitiveDefinition. A short --- contextual alias for 'primitiveDefinitionName', used by DSL source modules to --- reference primitive names via the generated Hydra.Lib.* definition modules (e.g. --- @primName Math.acos@) instead of hand-maintained name constants. -primName :: PrimitiveDefinition -> Name -primName = primitiveDefinitionName - --- 'ToPrimName' (used by prim0/prim1/prim2/prim3 below to accept a generated PrimitiveDefinition --- directly, e.g. @prim2 DefMath.add ...@) is defined in 'Hydra.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} - --- | Mark the value parameters at the given (0-based) positions of a primitive's --- signature as lazy. Used at the prim*-based registration sites in --- Hydra.Dsl.Libraries to record which arguments coders must thunk in hosts --- that distinguish strict from lazy evaluation (issue #391). The kernel DSL --- sources (Hydra.Sources.Kernel.Lib.*) carry the same flags via lazySig; this --- keeps the Haskell-host bootstrapGraph in agreement with the JSON. -lazyArgs :: [Int] -> Primitive -> Primitive -lazyArgs idxs p = p { primitiveDefinition = markLazyDef (primitiveDefinition p) } - where - markLazyDef d = d { - primitiveDefinitionSignature = markLazySig (primitiveDefinitionSignature d) } - markLazySig s = s { - Typing.termSignatureParameters = - zipWith markParam [0..] (Typing.termSignatureParameters s) } - markParam i param = - if i `elem` idxs then param { Typing.parameterIsLazy = True } else param - -either_ :: TermCoder x -> TermCoder y -> TermCoder (Prelude.Either x y) -either_ xCoder yCoder = TermCoder (Types.either_ (termCoderType xCoder) (termCoderType yCoder)) encode decode - where - encode cx g term = case term of - TermEither (Prelude.Left l) -> Prelude.Left <$> termCoderEncode xCoder cx g l - TermEither (Prelude.Right r) -> Prelude.Right <$> termCoderEncode yCoder cx g r - _ -> Left $ otherErr cx $ "expected either term, got: " ++ show term - decode cx ev = case ev of - Prelude.Left x -> do - xTerm <- termCoderDecode xCoder cx x - return $ Terms.left xTerm - Prelude.Right y -> do - yTerm <- termCoderDecode yCoder cx y - return $ Terms.right yTerm - -float32 :: TermCoder Float -float32 = TermCoder Types.float32 encode decode - where - encode _cx g = ExtractCore.float32 g - decode _cx = Right . Terms.float32 - -float64 :: TermCoder Double -float64 = TermCoder Types.float64 encode decode - where - encode _cx g = ExtractCore.float64 g - decode _cx = Right . Terms.float64 - -floatType :: TermCoder FloatType -floatType = TermCoder (TypeVariable _FloatType) encode decode - where - encode _cx g term = case DecodeCore.floatType g term of - Left err -> Left $ Error.ErrorDecoding err - Right v -> Right v - decode _cx = Right . EncodeCore.floatType - -floatValue :: TermCoder FloatValue -floatValue = TermCoder (TypeVariable _FloatValue) encode decode - where - encode _cx g = ExtractCore.floatValue g - decode _cx = Right . Terms.float - -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 - 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 --- evaluate the application eagerly, the bridged native function builds an UNREDUCED application --- term @apply funTerm argTerm@ and lets the interpreter's outer @reduce@ fold it. This is the --- replacement for @functionWithReduce@ for the higher-order primitives whose result shape is --- fixed by the (already-reduced) data argument's spine — i.e. those that never need to inspect --- the reduced value of a per-element application mid-computation. It threads no InferenceContext --- or Graph, which is what lets the @Primitive.implementation@ carrier drop those parameters. --- --- Only the encode side is defined (functions are never decoded back to terms), matching --- @functionWithReduce@. dom/cod are the term coders for the argument and result; for the --- higher-order primitives this is always the identity @term@/@variable@ coder, so a bridged --- @Term -> Term@ is @\\argTerm -> TermApplication (Application funTerm argTerm)@. -functionDeferred :: TermCoder x -> TermCoder y -> TermCoder (x -> y) -functionDeferred dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) encode decode - where - encode cx g funTerm = Right $ \x -> - let argTerm = case termCoderDecode dom cx x of - Left _ -> error "functionDeferred: failed to decode argument" - Right t -> t - resultTerm = TermApplication (Application funTerm argTerm) - in case termCoderEncode cod cx g resultTerm of - Left _ -> error "functionDeferred: failed to encode result" - Right v -> v - decode cx _val = Left $ otherErr cx "cannot decode functions to terms" - --- | A TermCoder for function types, using a reducer to bridge term-level functions to native functions. --- The reducer is called to evaluate function application at the term level. --- Failures in reduction or encoding/decoding will result in a runtime error. -functionWithReduce :: (Typing.InferenceContext -> Graph -> Term -> Either Error.Error Term) -> TermCoder x -> TermCoder y -> TermCoder (x -> y) -functionWithReduce reduce dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) encode decode - where - encode cx g funTerm = Right $ \x -> - let argTerm = case termCoderDecode dom cx x of - Left _ -> error "functionWithReduce: failed to encode argument" - Right t -> t - resultTerm = case reduce cx g (TermApplication (Application funTerm argTerm)) of - Left _ -> error "functionWithReduce: failed to reduce application" - Right t -> t - in case termCoderEncode cod cx g resultTerm of - Left _ -> error "functionWithReduce: failed to decode result" - Right v -> v - decode cx _val = Left $ otherErr cx "cannot decode functions to terms" - -int16 :: TermCoder Int16 -int16 = TermCoder Types.int16 encode decode - where - encode _cx g = ExtractCore.int16 g - decode _cx = Right . Terms.int16 - -int32 :: TermCoder Int -int32 = TermCoder Types.int32 encode decode - where - encode _cx g = ExtractCore.int32 g - decode _cx = Right . Terms.int32 - -int64 :: TermCoder Int64 -int64 = TermCoder Types.int64 encode decode - where - encode _cx g = ExtractCore.int64 g - decode _cx = Right . Terms.int64 - -int8 :: TermCoder Int8 -int8 = TermCoder Types.int8 encode decode - where - encode _cx g = ExtractCore.int8 g - decode _cx = Right . Terms.int8 - -integerType :: TermCoder IntegerType -integerType = TermCoder (TypeVariable _IntegerType) encode decode - where - encode _cx g term = case DecodeCore.integerType g term of - Left err -> Left $ Error.ErrorDecoding err - Right v -> Right v - decode _cx = Right . EncodeCore.integerType - -integerValue :: TermCoder IntegerValue -integerValue = TermCoder (TypeVariable _IntegerValue) encode decode - where - encode _cx g = ExtractCore.integerValue g - decode _cx = Right . Terms.integer - -list :: TermCoder x -> TermCoder [x] -list els = TermCoder (Types.list $ termCoderType els) encode decode - where - encode cx g = ExtractCore.listOf (termCoderEncode els cx g) g - decode cx l = Terms.list <$> mapM (termCoderDecode els cx) l - -literal :: TermCoder Literal -literal = TermCoder (TypeVariable _Literal) encode decode - where - encode _cx g = ExtractCore.literal g - decode _cx = Right . Terms.literal - -literalType :: TermCoder LiteralType -literalType = TermCoder (TypeVariable _LiteralType) encode decode - where - encode _cx g term = case DecodeCore.literalType g term of - Left err -> Left $ Error.ErrorDecoding err - Right v -> Right v - decode _cx = Right . EncodeCore.literalType - -map :: Ord k => TermCoder k -> TermCoder v -> TermCoder (M.Map k v) -map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) encode decode - where - encode cx g = ExtractCore.map (termCoderEncode keys cx g) (termCoderEncode values cx g) g - decode cx m = Terms.map . M.fromList <$> mapM decodePair (M.toList m) - where - decodePair (k, v) = do - ke <- termCoderDecode keys cx k - ve <- termCoderDecode values cx v - return (ke, ve) - -optional :: TermCoder x -> TermCoder (Y.Maybe x) -optional mel = TermCoder (Types.optional $ termCoderType mel) encode decode - where - encode cx g = ExtractCore.optionalTerm (termCoderEncode mel cx g) g - decode cx mv = Terms.optional <$> case mv of - Nothing -> pure Nothing - Just v -> Just <$> termCoderDecode mel cx v - --- | A helper to create an Error from a string message and context -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 - encode cx g = ExtractCore.pair (termCoderEncode xCoder cx g) (termCoderEncode yCoder cx g) g - decode cx (x, y) = do - xTerm <- termCoderDecode xCoder cx x - 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 - 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 - where - name = toPrimName n - typ = buildTypeScheme vars $ Types.functionMany [ - termCoderType input1, - termCoderType output] - impl g args = do - ExtractCore.nArgs name 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 - where - name = toPrimName n - typ = buildTypeScheme vars $ Types.functionMany [ - termCoderType input1, - termCoderType input2, - termCoderType output] - impl g args = do - ExtractCore.nArgs name 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 - 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 - arg1 <- termCoderEncode input1 primCx g (args !! 0) - arg2 <- termCoderEncode input2 primCx g (args !! 1) - arg3 <- termCoderEncode input3 primCx g (args !! 2) - termCoderDecode output primCx $ compute arg1 arg2 arg3 - -set :: Ord x => TermCoder x -> TermCoder (S.Set x) -set els = TermCoder (Types.set $ termCoderType els) encode decode - where - encode cx g = ExtractCore.setOf (termCoderEncode els cx g) g - decode cx s = Terms.set . S.fromList <$> mapM (termCoderDecode els cx) (S.toList s) - -string :: TermCoder String -string = TermCoder Types.string encode decode - where - encode _cx g = ExtractCore.string g - decode _cx = Right . Terms.string - -term :: TermCoder Term -term = TermCoder (TypeVariable _Term) encode decode - where - 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 - encode _cx g t = case DecodeCore.type_ g t of - Left err -> Left $ Error.ErrorDecoding err - Right v -> Right v - decode _cx = Right . EncodeCore.type_ - -uint16 :: TermCoder Int -uint16 = TermCoder Types.uint16 encode decode - where - encode _cx g = ExtractCore.uint16 g - decode _cx = Right . Terms.uint16 - -uint32 :: TermCoder Int64 -uint32 = TermCoder Types.uint32 encode decode - where - encode _cx g = ExtractCore.uint32 g - decode _cx = Right . Terms.uint32 - -uint64 :: TermCoder Integer -uint64 = TermCoder Types.uint64 encode decode - where - encode _cx g = ExtractCore.uint64 g - decode _cx = Right . Terms.uint64 - -uint8 :: TermCoder Int16 -uint8 = TermCoder Types.uint8 encode decode - 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 - where - encode _cx _g = Right - decode _cx = Right 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.query module Hydra.Dsl.Query where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore 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 injection for the equal variant of hydra.query.ComparisonConstraint comparisonConstraintEqual :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintEqual = @@ -16,6 +19,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "equal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the greaterThan variant of hydra.query.ComparisonConstraint comparisonConstraintGreaterThan :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintGreaterThan = @@ -24,6 +28,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "greaterThan"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the greaterThanOrEqual variant of hydra.query.ComparisonConstraint comparisonConstraintGreaterThanOrEqual :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintGreaterThanOrEqual = @@ -32,6 +37,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "greaterThanOrEqual"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lessThan variant of hydra.query.ComparisonConstraint comparisonConstraintLessThan :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintLessThan = @@ -40,6 +46,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lessThan"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lessThanOrEqual variant of hydra.query.ComparisonConstraint comparisonConstraintLessThanOrEqual :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintLessThanOrEqual = @@ -48,6 +55,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lessThanOrEqual"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the notEqual variant of hydra.query.ComparisonConstraint comparisonConstraintNotEqual :: Typed.TypedTerm Query.ComparisonConstraint comparisonConstraintNotEqual = @@ -56,6 +64,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "notEqual"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.query.Edge edge :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe Core.Name) -> Typed.TypedTerm (Maybe Core.Name) -> Typed.TypedTerm Query.Edge edge type_ out in_ = @@ -71,6 +80,7 @@ Core.Field { Core.fieldName = (Core.Name "in"), Core.fieldTerm = (Typed.unTypedTerm in_)}]})) + -- | DSL accessor for the in field of hydra.query.Edge edgeIn :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm (Maybe Core.Name) edgeIn x = @@ -79,6 +89,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Edge"), Core.projectionFieldName = (Core.Name "in")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the out field of hydra.query.Edge edgeOut :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm (Maybe Core.Name) edgeOut x = @@ -87,6 +98,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Edge"), Core.projectionFieldName = (Core.Name "out")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.query.Edge edgeType :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm Core.Name edgeType x = @@ -95,6 +107,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Edge"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the in field of hydra.query.Edge edgeWithIn :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm (Maybe Core.Name) -> Typed.TypedTerm Query.Edge edgeWithIn original newVal = @@ -118,6 +131,7 @@ Core.Field { Core.fieldName = (Core.Name "in"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the out field of hydra.query.Edge edgeWithOut :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm (Maybe Core.Name) -> Typed.TypedTerm Query.Edge edgeWithOut original newVal = @@ -141,6 +155,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Edge"), Core.projectionFieldName = (Core.Name "in")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.query.Edge edgeWithType :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Query.Edge edgeWithType original newVal = @@ -164,6 +179,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Edge"), Core.projectionFieldName = (Core.Name "in")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.query.GraphPattern graphPattern :: Typed.TypedTerm Core.Name -> Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.GraphPattern graphPattern graph patterns = @@ -176,6 +192,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = (Typed.unTypedTerm patterns)}]})) + -- | DSL accessor for the graph field of hydra.query.GraphPattern graphPatternGraph :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm Core.Name graphPatternGraph x = @@ -184,6 +201,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.GraphPattern"), Core.projectionFieldName = (Core.Name "graph")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the patterns field of hydra.query.GraphPattern graphPatternPatterns :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm [Query.Pattern] graphPatternPatterns x = @@ -192,6 +210,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.GraphPattern"), Core.projectionFieldName = (Core.Name "patterns")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the graph field of hydra.query.GraphPattern graphPatternWithGraph :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Query.GraphPattern graphPatternWithGraph original newVal = @@ -208,6 +227,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.GraphPattern"), Core.projectionFieldName = (Core.Name "patterns")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the patterns field of hydra.query.GraphPattern graphPatternWithPatterns :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.GraphPattern graphPatternWithPatterns original newVal = @@ -224,6 +244,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the term variant of hydra.query.Node nodeTerm :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Query.Node nodeTerm x = @@ -232,6 +253,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the variable variant of hydra.query.Node nodeVariable :: Typed.TypedTerm Query.Variable -> Typed.TypedTerm Query.Node nodeVariable x = @@ -240,6 +262,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the wildcard variant of hydra.query.Node nodeWildcard :: Typed.TypedTerm Query.Node nodeWildcard = @@ -248,6 +271,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wildcard"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.query.PathEquation pathEquation :: Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.PathEquation pathEquation left right = @@ -260,6 +284,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm right)}]})) + -- | DSL accessor for the left field of hydra.query.PathEquation pathEquationLeft :: Typed.TypedTerm Query.PathEquation -> Typed.TypedTerm Query.Path pathEquationLeft x = @@ -268,6 +293,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PathEquation"), Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the right field of hydra.query.PathEquation pathEquationRight :: Typed.TypedTerm Query.PathEquation -> Typed.TypedTerm Query.Path pathEquationRight x = @@ -276,6 +302,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PathEquation"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the left field of hydra.query.PathEquation pathEquationWithLeft :: Typed.TypedTerm Query.PathEquation -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.PathEquation pathEquationWithLeft original newVal = @@ -292,6 +319,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PathEquation"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the right field of hydra.query.PathEquation pathEquationWithRight :: Typed.TypedTerm Query.PathEquation -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.PathEquation pathEquationWithRight original newVal = @@ -308,6 +336,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the inverse variant of hydra.query.Path pathInverse :: Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.Path pathInverse x = @@ -316,6 +345,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "inverse"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the regex variant of hydra.query.Path pathRegex :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.Path pathRegex x = @@ -324,6 +354,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "regex"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the step variant of hydra.query.Path pathStep :: Typed.TypedTerm Query.Step -> Typed.TypedTerm Query.Path pathStep x = @@ -332,6 +363,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "step"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the conjunction variant of hydra.query.Pattern patternConjunction :: Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.Pattern patternConjunction x = @@ -340,6 +372,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "conjunction"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the disjunction variant of hydra.query.Pattern patternDisjunction :: Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.Pattern patternDisjunction x = @@ -348,6 +381,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "disjunction"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the graph variant of hydra.query.Pattern patternGraph :: Typed.TypedTerm Query.GraphPattern -> Typed.TypedTerm Query.Pattern patternGraph x = @@ -356,6 +390,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "graph"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.query.PatternImplication patternImplication :: Typed.TypedTerm Query.Pattern -> Typed.TypedTerm Query.Pattern -> Typed.TypedTerm Query.PatternImplication patternImplication antecedent consequent = @@ -368,6 +403,7 @@ Core.Field { Core.fieldName = (Core.Name "consequent"), Core.fieldTerm = (Typed.unTypedTerm consequent)}]})) + -- | DSL accessor for the antecedent field of hydra.query.PatternImplication patternImplicationAntecedent :: Typed.TypedTerm Query.PatternImplication -> Typed.TypedTerm Query.Pattern patternImplicationAntecedent x = @@ -376,6 +412,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PatternImplication"), Core.projectionFieldName = (Core.Name "antecedent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the consequent field of hydra.query.PatternImplication patternImplicationConsequent :: Typed.TypedTerm Query.PatternImplication -> Typed.TypedTerm Query.Pattern patternImplicationConsequent x = @@ -384,6 +421,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PatternImplication"), Core.projectionFieldName = (Core.Name "consequent")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -400,6 +438,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.PatternImplication"), Core.projectionFieldName = (Core.Name "consequent")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the consequent field of hydra.query.PatternImplication patternImplicationWithConsequent :: Typed.TypedTerm Query.PatternImplication -> Typed.TypedTerm Query.Pattern -> Typed.TypedTerm Query.PatternImplication patternImplicationWithConsequent original newVal = @@ -416,6 +455,7 @@ Core.Field { Core.fieldName = (Core.Name "consequent"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the negation variant of hydra.query.Pattern patternNegation :: Typed.TypedTerm Query.Pattern -> Typed.TypedTerm Query.Pattern patternNegation x = @@ -424,6 +464,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "negation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the triple variant of hydra.query.Pattern patternTriple :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Pattern patternTriple x = @@ -432,6 +473,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "triple"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.query.Query query :: Typed.TypedTerm [Query.Variable] -> Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.Query query variables patterns = @@ -444,6 +486,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = (Typed.unTypedTerm patterns)}]})) + -- | DSL accessor for the patterns field of hydra.query.Query queryPatterns :: Typed.TypedTerm Query.Query -> Typed.TypedTerm [Query.Pattern] queryPatterns x = @@ -452,6 +495,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Query"), Core.projectionFieldName = (Core.Name "patterns")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the variables field of hydra.query.Query queryVariables :: Typed.TypedTerm Query.Query -> Typed.TypedTerm [Query.Variable] queryVariables x = @@ -460,6 +504,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Query"), Core.projectionFieldName = (Core.Name "variables")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the patterns field of hydra.query.Query queryWithPatterns :: Typed.TypedTerm Query.Query -> Typed.TypedTerm [Query.Pattern] -> Typed.TypedTerm Query.Query queryWithPatterns original newVal = @@ -476,6 +521,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the variables field of hydra.query.Query queryWithVariables :: Typed.TypedTerm Query.Query -> Typed.TypedTerm [Query.Variable] -> Typed.TypedTerm Query.Query queryWithVariables original newVal = @@ -492,6 +538,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Query"), Core.projectionFieldName = (Core.Name "patterns")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.query.Range range :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm Query.Range range min max = @@ -504,6 +551,7 @@ Core.Field { Core.fieldName = (Core.Name "max"), Core.fieldTerm = (Typed.unTypedTerm max)}]})) + -- | DSL accessor for the max field of hydra.query.Range rangeMax :: Typed.TypedTerm Query.Range -> Typed.TypedTerm Int rangeMax x = @@ -512,6 +560,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Range"), Core.projectionFieldName = (Core.Name "max")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the min field of hydra.query.Range rangeMin :: Typed.TypedTerm Query.Range -> Typed.TypedTerm Int rangeMin x = @@ -520,6 +569,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Range"), Core.projectionFieldName = (Core.Name "min")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -536,6 +586,7 @@ Core.Field { Core.fieldName = (Core.Name "max"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the min field of hydra.query.Range rangeWithMin :: Typed.TypedTerm Query.Range -> Typed.TypedTerm Int -> Typed.TypedTerm Query.Range rangeWithMin original newVal = @@ -552,6 +603,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.Range"), Core.projectionFieldName = (Core.Name "max")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL injection for the atLeast variant of hydra.query.RegexQuantifier regexQuantifierAtLeast :: Typed.TypedTerm Int -> Typed.TypedTerm Query.RegexQuantifier regexQuantifierAtLeast x = @@ -560,6 +612,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "atLeast"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the exactly variant of hydra.query.RegexQuantifier regexQuantifierExactly :: Typed.TypedTerm Int -> Typed.TypedTerm Query.RegexQuantifier regexQuantifierExactly x = @@ -568,6 +621,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "exactly"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the one variant of hydra.query.RegexQuantifier regexQuantifierOne :: Typed.TypedTerm Query.RegexQuantifier regexQuantifierOne = @@ -576,6 +630,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "one"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the oneOrMore variant of hydra.query.RegexQuantifier regexQuantifierOneOrMore :: Typed.TypedTerm Query.RegexQuantifier regexQuantifierOneOrMore = @@ -584,6 +639,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "oneOrMore"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the range variant of hydra.query.RegexQuantifier regexQuantifierRange :: Typed.TypedTerm Query.Range -> Typed.TypedTerm Query.RegexQuantifier regexQuantifierRange x = @@ -592,6 +648,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "range"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the zeroOrMore variant of hydra.query.RegexQuantifier regexQuantifierZeroOrMore :: Typed.TypedTerm Query.RegexQuantifier regexQuantifierZeroOrMore = @@ -600,6 +657,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "zeroOrMore"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the zeroOrOne variant of hydra.query.RegexQuantifier regexQuantifierZeroOrOne :: Typed.TypedTerm Query.RegexQuantifier regexQuantifierZeroOrOne = @@ -608,6 +666,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "zeroOrOne"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL constructor for hydra.query.RegexSequence regexSequence :: Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.RegexQuantifier -> Typed.TypedTerm Query.RegexSequence regexSequence path quantifier = @@ -620,6 +679,7 @@ Core.Field { Core.fieldName = (Core.Name "quantifier"), Core.fieldTerm = (Typed.unTypedTerm quantifier)}]})) + -- | DSL accessor for the path field of hydra.query.RegexSequence regexSequencePath :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.Path regexSequencePath x = @@ -628,6 +688,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.RegexSequence"), Core.projectionFieldName = (Core.Name "path")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the quantifier field of hydra.query.RegexSequence regexSequenceQuantifier :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.RegexQuantifier regexSequenceQuantifier x = @@ -636,6 +697,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.RegexSequence"), Core.projectionFieldName = (Core.Name "quantifier")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -652,6 +714,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.RegexSequence"), Core.projectionFieldName = (Core.Name "quantifier")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the quantifier field of hydra.query.RegexSequence regexSequenceWithQuantifier :: Typed.TypedTerm Query.RegexSequence -> Typed.TypedTerm Query.RegexQuantifier -> Typed.TypedTerm Query.RegexSequence regexSequenceWithQuantifier original newVal = @@ -668,6 +731,7 @@ Core.Field { Core.fieldName = (Core.Name "quantifier"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the compare variant of hydra.query.Step stepCompare :: Typed.TypedTerm Query.ComparisonConstraint -> Typed.TypedTerm Query.Step stepCompare x = @@ -676,6 +740,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "compare"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the edge variant of hydra.query.Step stepEdge :: Typed.TypedTerm Query.Edge -> Typed.TypedTerm Query.Step stepEdge x = @@ -684,6 +749,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "edge"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the project variant of hydra.query.Step stepProject :: Typed.TypedTerm Core.Projection -> Typed.TypedTerm Query.Step stepProject x = @@ -692,6 +758,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "project"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | 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 = @@ -707,6 +774,7 @@ Core.Field { Core.fieldName = (Core.Name "object"), Core.fieldTerm = (Typed.unTypedTerm object)}]})) + -- | DSL accessor for the object field of hydra.query.TriplePattern triplePatternObject :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Node triplePatternObject x = @@ -715,6 +783,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.TriplePattern"), Core.projectionFieldName = (Core.Name "object")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the predicate field of hydra.query.TriplePattern triplePatternPredicate :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Path triplePatternPredicate x = @@ -723,6 +792,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.TriplePattern"), Core.projectionFieldName = (Core.Name "predicate")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the subject field of hydra.query.TriplePattern triplePatternSubject :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Node triplePatternSubject x = @@ -731,6 +801,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.TriplePattern"), Core.projectionFieldName = (Core.Name "subject")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -754,6 +825,7 @@ Core.Field { Core.fieldName = (Core.Name "object"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the predicate field of hydra.query.TriplePattern triplePatternWithPredicate :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Path -> Typed.TypedTerm Query.TriplePattern triplePatternWithPredicate original newVal = @@ -777,6 +849,7 @@ Core.projectionTypeName = (Core.Name "hydra.query.TriplePattern"), Core.projectionFieldName = (Core.Name "object")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the subject field of hydra.query.TriplePattern triplePatternWithSubject :: Typed.TypedTerm Query.TriplePattern -> Typed.TypedTerm Query.Node -> Typed.TypedTerm Query.TriplePattern triplePatternWithSubject original newVal = @@ -800,12 +873,14 @@ Core.projectionTypeName = (Core.Name "hydra.query.TriplePattern"), Core.projectionFieldName = (Core.Name "object")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the body of hydra.query.Variable unVariable :: Typed.TypedTerm Query.Variable -> Typed.TypedTerm String unVariable x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.query.Variable")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.query.Variable wrapper variable :: Typed.TypedTerm String -> Typed.TypedTerm Query.Variable variable x = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.relational module Hydra.Dsl.Relational where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Relational as Relational @@ -10,12 +12,14 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | DSL constructor for the hydra.relational.ColumnName wrapper columnName :: Typed.TypedTerm String -> Typed.TypedTerm Relational.ColumnName columnName x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.ColumnName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.relational.ColumnSchema columnSchema :: Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm t -> Typed.TypedTerm (Relational.ColumnSchema t) columnSchema name domain = @@ -28,6 +32,7 @@ Core.Field { Core.fieldName = (Core.Name "domain"), Core.fieldTerm = (Typed.unTypedTerm domain)}]})) + -- | DSL accessor for the domain field of hydra.relational.ColumnSchema columnSchemaDomain :: Typed.TypedTerm (Relational.ColumnSchema t) -> Typed.TypedTerm t columnSchemaDomain x = @@ -36,6 +41,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ColumnSchema"), Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.relational.ColumnSchema columnSchemaName :: Typed.TypedTerm (Relational.ColumnSchema t) -> Typed.TypedTerm Relational.ColumnName columnSchemaName x = @@ -44,6 +50,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ColumnSchema"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the domain field of hydra.relational.ColumnSchema columnSchemaWithDomain :: Typed.TypedTerm (Relational.ColumnSchema t) -> Typed.TypedTerm t -> Typed.TypedTerm (Relational.ColumnSchema t) columnSchemaWithDomain original newVal = @@ -60,6 +67,7 @@ Core.Field { Core.fieldName = (Core.Name "domain"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.relational.ColumnSchema columnSchemaWithName :: Typed.TypedTerm (Relational.ColumnSchema t) -> Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm (Relational.ColumnSchema t) columnSchemaWithName original newVal = @@ -76,6 +84,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ColumnSchema"), Core.projectionFieldName = (Core.Name "domain")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | 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 = @@ -88,6 +97,7 @@ Core.Field { Core.fieldName = (Core.Name "keys"), Core.fieldTerm = (Typed.unTypedTerm keys)}]})) + -- | DSL accessor for the foreignRelation field of hydra.relational.ForeignKey foreignKeyForeignRelation :: Typed.TypedTerm Relational.ForeignKey -> Typed.TypedTerm Relational.RelationName foreignKeyForeignRelation x = @@ -96,6 +106,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ForeignKey"), Core.projectionFieldName = (Core.Name "foreignRelation")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the keys field of hydra.relational.ForeignKey foreignKeyKeys :: Typed.TypedTerm Relational.ForeignKey -> Typed.TypedTerm (M.Map Relational.ColumnName Relational.ColumnName) foreignKeyKeys x = @@ -104,6 +115,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ForeignKey"), Core.projectionFieldName = (Core.Name "keys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the foreignRelation field of hydra.relational.ForeignKey foreignKeyWithForeignRelation :: Typed.TypedTerm Relational.ForeignKey -> Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm Relational.ForeignKey foreignKeyWithForeignRelation original newVal = @@ -120,6 +132,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.ForeignKey"), Core.projectionFieldName = (Core.Name "keys")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the keys field of hydra.relational.ForeignKey foreignKeyWithKeys :: Typed.TypedTerm Relational.ForeignKey -> Typed.TypedTerm (M.Map Relational.ColumnName Relational.ColumnName) -> Typed.TypedTerm Relational.ForeignKey foreignKeyWithKeys original newVal = @@ -136,24 +149,28 @@ Core.Field { Core.fieldName = (Core.Name "keys"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.relational.PrimaryKey wrapper primaryKey :: Typed.TypedTerm [Relational.ColumnName] -> Typed.TypedTerm Relational.PrimaryKey primaryKey x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.PrimaryKey"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.relational.Relation wrapper relation :: Typed.TypedTerm [Relational.Row v] -> Typed.TypedTerm (Relational.Relation v) relation x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.Relation"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.relational.RelationName wrapper relationName :: Typed.TypedTerm String -> Typed.TypedTerm Relational.RelationName relationName x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.RelationName"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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 = @@ -172,6 +189,7 @@ Core.Field { Core.fieldName = (Core.Name "foreignKeys"), Core.fieldTerm = (Typed.unTypedTerm foreignKeys)}]})) + -- | DSL accessor for the columns field of hydra.relational.RelationSchema relationSchemaColumns :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.ColumnSchema t] relationSchemaColumns x = @@ -180,6 +198,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "columns")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the foreignKeys field of hydra.relational.RelationSchema relationSchemaForeignKeys :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.ForeignKey] relationSchemaForeignKeys x = @@ -188,6 +207,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "foreignKeys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.relational.RelationSchema relationSchemaName :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm Relational.RelationName relationSchemaName x = @@ -196,6 +216,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the primaryKeys field of hydra.relational.RelationSchema relationSchemaPrimaryKeys :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.PrimaryKey] relationSchemaPrimaryKeys x = @@ -204,6 +225,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "primaryKeys")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -234,6 +256,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "foreignKeys")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the foreignKeys field of hydra.relational.RelationSchema relationSchemaWithForeignKeys :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.ForeignKey] -> Typed.TypedTerm (Relational.RelationSchema t) relationSchemaWithForeignKeys original newVal = @@ -264,6 +287,7 @@ Core.Field { Core.fieldName = (Core.Name "foreignKeys"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.relational.RelationSchema relationSchemaWithName :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm (Relational.RelationSchema t) relationSchemaWithName original newVal = @@ -294,6 +318,7 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "foreignKeys")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the primaryKeys field of hydra.relational.RelationSchema relationSchemaWithPrimaryKeys :: Typed.TypedTerm (Relational.RelationSchema t) -> Typed.TypedTerm [Relational.PrimaryKey] -> Typed.TypedTerm (Relational.RelationSchema t) relationSchemaWithPrimaryKeys original newVal = @@ -324,48 +349,56 @@ Core.projectionTypeName = (Core.Name "hydra.relational.RelationSchema"), Core.projectionFieldName = (Core.Name "foreignKeys")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.relational.Relationship wrapper relationship :: Typed.TypedTerm (S.Set (M.Map Relational.ColumnName v)) -> Typed.TypedTerm (Relational.Relationship v) relationship x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.Relationship"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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 accessor for the body of hydra.relational.ColumnName unColumnName :: Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm String unColumnName x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.relational.ColumnName")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.relational.PrimaryKey unPrimaryKey :: Typed.TypedTerm Relational.PrimaryKey -> Typed.TypedTerm [Relational.ColumnName] unPrimaryKey x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.relational.PrimaryKey")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.relational.Relation unRelation :: Typed.TypedTerm (Relational.Relation v) -> Typed.TypedTerm [Relational.Row v] unRelation x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.relational.Relation")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.relational.RelationName unRelationName :: Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm String unRelationName x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.relational.RelationName")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.relational.Relationship unRelationship :: Typed.TypedTerm (Relational.Relationship v) -> Typed.TypedTerm (S.Set (M.Map Relational.ColumnName v)) unRelationship x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.relational.Relationship")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.relational.Row unRow :: Typed.TypedTerm (Relational.Row v) -> Typed.TypedTerm [v] unRow x = diff --git a/src/main/haskell/Hydra/Dsl/System.hs b/src/main/haskell/Hydra/Dsl/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/System.hs @@ -0,0 +1,338 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.system + +module Hydra.Dsl.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Dsl.File as DslFile +import qualified Hydra.File as File +import qualified Hydra.System as System +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.ByteString as B +import qualified Data.Map as M + +-- | DSL constructor for hydra.system.Command +command :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm [String] -> Typed.TypedTerm (Maybe File.FilePath) -> Typed.TypedTerm (Maybe (M.Map System.EnvironmentVariable String)) -> Typed.TypedTerm System.Command +command program arguments workingDirectory environment = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (Typed.unTypedTerm program)}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = (Typed.unTypedTerm arguments)}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = (Typed.unTypedTerm workingDirectory)}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = (Typed.unTypedTerm environment)}]})) + +-- | DSL accessor for the arguments field of hydra.system.Command +commandArguments :: Typed.TypedTerm System.Command -> Typed.TypedTerm [String] +commandArguments x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "arguments")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | 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 = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "environment")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the program field of hydra.system.Command +commandProgram :: Typed.TypedTerm System.Command -> Typed.TypedTerm File.FilePath +commandProgram x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "program")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the arguments field of hydra.system.Command +commandWithArguments :: Typed.TypedTerm System.Command -> Typed.TypedTerm [String] -> Typed.TypedTerm System.Command +commandWithArguments original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "program")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "workingDirectory")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "environment")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the environment field of hydra.system.Command +commandWithEnvironment :: Typed.TypedTerm System.Command -> Typed.TypedTerm (Maybe (M.Map System.EnvironmentVariable String)) -> Typed.TypedTerm System.Command +commandWithEnvironment original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "program")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "arguments")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "workingDirectory")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the program field of hydra.system.Command +commandWithProgram :: Typed.TypedTerm System.Command -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm System.Command +commandWithProgram original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "arguments")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "workingDirectory")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "environment")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the workingDirectory field of hydra.system.Command +commandWithWorkingDirectory :: Typed.TypedTerm System.Command -> Typed.TypedTerm (Maybe File.FilePath) -> Typed.TypedTerm System.Command +commandWithWorkingDirectory original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "program")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "arguments")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "environment")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL accessor for the workingDirectory field of hydra.system.Command +commandWorkingDirectory :: Typed.TypedTerm System.Command -> Typed.TypedTerm (Maybe File.FilePath) +commandWorkingDirectory x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.Command"), + Core.projectionFieldName = (Core.Name "workingDirectory")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL constructor for the hydra.system.EnvironmentVariable wrapper +environmentVariable :: Typed.TypedTerm String -> Typed.TypedTerm System.EnvironmentVariable +environmentVariable x = + Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.system.EnvironmentVariable"), + Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | 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 = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "exitCode"), + Core.fieldTerm = (Typed.unTypedTerm exitCode)}, + Core.Field { + Core.fieldName = (Core.Name "stdout"), + Core.fieldTerm = (Typed.unTypedTerm stdout)}, + Core.Field { + Core.fieldName = (Core.Name "stderr"), + Core.fieldTerm = (Typed.unTypedTerm stderr)}]})) + +-- | DSL accessor for the exitCode field of hydra.system.ProcessResult +processResultExitCode :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm System.StatusCode +processResultExitCode x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "exitCode")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the stderr field of hydra.system.ProcessResult +processResultStderr :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm B.ByteString +processResultStderr x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stderr")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the stdout field of hydra.system.ProcessResult +processResultStdout :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm B.ByteString +processResultStdout x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stdout")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the exitCode field of hydra.system.ProcessResult +processResultWithExitCode :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm System.StatusCode -> Typed.TypedTerm System.ProcessResult +processResultWithExitCode original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "exitCode"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "stdout"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stdout")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "stderr"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stderr")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the stderr field of hydra.system.ProcessResult +processResultWithStderr :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm System.ProcessResult +processResultWithStderr original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "exitCode"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "exitCode")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "stdout"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stdout")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "stderr"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the stdout field of hydra.system.ProcessResult +processResultWithStdout :: Typed.TypedTerm System.ProcessResult -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm System.ProcessResult +processResultWithStdout original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "exitCode"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "exitCode")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "stdout"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "stderr"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.projectionFieldName = (Core.Name "stderr")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL constructor for the hydra.system.StatusCode wrapper +statusCode :: Typed.TypedTerm Int -> Typed.TypedTerm System.StatusCode +statusCode x = + Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.system.StatusCode"), + Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the body of hydra.system.EnvironmentVariable +unEnvironmentVariable :: Typed.TypedTerm System.EnvironmentVariable -> Typed.TypedTerm String +unEnvironmentVariable x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.system.EnvironmentVariable")), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the body of hydra.system.StatusCode +unStatusCode :: Typed.TypedTerm System.StatusCode -> Typed.TypedTerm Int +unStatusCode x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.system.StatusCode")), + Core.applicationArgument = (Typed.unTypedTerm x)})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.tabular module Hydra.Dsl.Tabular where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Relational as DslRelational @@ -10,6 +12,7 @@ import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL constructor for hydra.tabular.ColumnType columnType :: Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Tabular.ColumnType columnType name type_ = @@ -22,6 +25,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the name field of hydra.tabular.ColumnType columnTypeName :: Typed.TypedTerm Tabular.ColumnType -> Typed.TypedTerm Relational.ColumnName columnTypeName x = @@ -30,6 +34,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.ColumnType"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.tabular.ColumnType columnTypeType :: Typed.TypedTerm Tabular.ColumnType -> Typed.TypedTerm Core.Type columnTypeType x = @@ -38,6 +43,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.ColumnType"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the name field of hydra.tabular.ColumnType columnTypeWithName :: Typed.TypedTerm Tabular.ColumnType -> Typed.TypedTerm Relational.ColumnName -> Typed.TypedTerm Tabular.ColumnType columnTypeWithName original newVal = @@ -54,6 +60,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.ColumnType"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.tabular.ColumnType columnTypeWithType :: Typed.TypedTerm Tabular.ColumnType -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Tabular.ColumnType columnTypeWithType original newVal = @@ -70,18 +77,21 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.tabular.DataRow wrapper dataRow :: Typed.TypedTerm [Maybe v] -> Typed.TypedTerm (Tabular.DataRow v) dataRow x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.tabular.DataRow"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for the hydra.tabular.HeaderRow wrapper headerRow :: Typed.TypedTerm [String] -> Typed.TypedTerm Tabular.HeaderRow headerRow x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.tabular.HeaderRow"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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_ = @@ -94,6 +104,7 @@ Core.Field { Core.fieldName = (Core.Name "data"), Core.fieldTerm = (Typed.unTypedTerm data_)}]})) + -- | DSL accessor for the data field of hydra.tabular.Table tableData :: Typed.TypedTerm (Tabular.Table v) -> Typed.TypedTerm [Tabular.DataRow v] tableData x = @@ -102,6 +113,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.Table"), Core.projectionFieldName = (Core.Name "data")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the header field of hydra.tabular.Table tableHeader :: Typed.TypedTerm (Tabular.Table v) -> Typed.TypedTerm (Maybe Tabular.HeaderRow) tableHeader x = @@ -110,6 +122,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.Table"), Core.projectionFieldName = (Core.Name "header")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.tabular.TableType tableType :: Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm [Tabular.ColumnType] -> Typed.TypedTerm Tabular.TableType tableType name columns = @@ -122,6 +135,7 @@ Core.Field { Core.fieldName = (Core.Name "columns"), Core.fieldTerm = (Typed.unTypedTerm columns)}]})) + -- | DSL accessor for the columns field of hydra.tabular.TableType tableTypeColumns :: Typed.TypedTerm Tabular.TableType -> Typed.TypedTerm [Tabular.ColumnType] tableTypeColumns x = @@ -130,6 +144,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.TableType"), Core.projectionFieldName = (Core.Name "columns")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.tabular.TableType tableTypeName :: Typed.TypedTerm Tabular.TableType -> Typed.TypedTerm Relational.RelationName tableTypeName x = @@ -138,6 +153,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.TableType"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the columns field of hydra.tabular.TableType tableTypeWithColumns :: Typed.TypedTerm Tabular.TableType -> Typed.TypedTerm [Tabular.ColumnType] -> Typed.TypedTerm Tabular.TableType tableTypeWithColumns original newVal = @@ -154,6 +170,7 @@ Core.Field { Core.fieldName = (Core.Name "columns"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.tabular.TableType tableTypeWithName :: Typed.TypedTerm Tabular.TableType -> Typed.TypedTerm Relational.RelationName -> Typed.TypedTerm Tabular.TableType tableTypeWithName original newVal = @@ -170,6 +187,7 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.TableType"), Core.projectionFieldName = (Core.Name "columns")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the data field of hydra.tabular.Table tableWithData :: Typed.TypedTerm (Tabular.Table v) -> Typed.TypedTerm [Tabular.DataRow v] -> Typed.TypedTerm (Tabular.Table v) tableWithData original newVal = @@ -186,6 +204,7 @@ Core.Field { Core.fieldName = (Core.Name "data"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the header field of hydra.tabular.Table tableWithHeader :: Typed.TypedTerm (Tabular.Table v) -> Typed.TypedTerm (Maybe Tabular.HeaderRow) -> Typed.TypedTerm (Tabular.Table v) tableWithHeader original newVal = @@ -202,12 +221,14 @@ Core.projectionTypeName = (Core.Name "hydra.tabular.Table"), Core.projectionFieldName = (Core.Name "data")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the body of hydra.tabular.DataRow unDataRow :: Typed.TypedTerm (Tabular.DataRow v) -> Typed.TypedTerm [Maybe v] unDataRow x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.tabular.DataRow")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.tabular.HeaderRow unHeaderRow :: Typed.TypedTerm Tabular.HeaderRow -> Typed.TypedTerm [String] unHeaderRow x = diff --git a/src/main/haskell/Hydra/Dsl/Terms.hs b/src/main/haskell/Hydra/Dsl/Terms.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Terms.hs +++ /dev/null @@ -1,403 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - --- | A domain-specific language for constructing Hydra terms in Haskell. -module Hydra.Dsl.Terms where - -import Hydra.Constants -import Hydra.Core -import Hydra.Graph -import Hydra.Packaging (PrimitiveDefinition, primitiveDefinitionName) -import Hydra.Util -import Hydra.Dsl.Meta.Common -import qualified Hydra.Dsl.Literals as Literals - -import Prelude hiding (map, product) -import Data.Int -import qualified Data.ByteString as B -import qualified Data.Char as C -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Scientific as Sci -import qualified Data.Set as S - - --- | Function composition operator: f <.> g creates a function that applies g then f --- Example: var "stringLength" <.> var "toString" -(<.>) :: Term -> Term -> Term -f <.> g = compose f g - --- | Term application operator: function @@ argument --- Example: var "add" @@ int32 1 -(@@) :: Term -> Term -> Term -fun @@ arg = apply fun arg - --- | Field definition operator: name>: value --- Example: "name">: string "John" -infixr 0 >: -(>:) :: String -> Term -> Field -name>: term = field name term - --- | Attach an annotation map to a term, wrapping the map as a TermMap per --- Hydra's convention (#386 — annotation is now a Term, not a Map). --- Each Name key is lifted to a TermVariable. --- Example: annot (M.fromList [(Name "comment", string "A User ID")]) (var "userId") -annot :: M.Map Name Term -> Term -> Term -annot ann term = TermAnnotated $ AnnotatedTerm term (annotationMapAsTerm ann) - --- | Attach an annotation map to a term (alternative argument order). --- Example: annotated (var "userId") (M.fromList [(Name "comment", string "A User ID")]) -annotated :: Term -> M.Map Name Term -> Term -annotated term ann = TermAnnotated $ AnnotatedTerm term (annotationMapAsTerm ann) - --- | Wrap a Map as a TermMap annotation. Each Name key becomes a --- TermVariable key. The canonical encoding for Hydra's annotation map --- convention (#386). -annotationMapAsTerm :: M.Map Name Term -> Term -annotationMapAsTerm = TermMap . M.mapKeys TermVariable - --- | Apply a function term to an argument --- Example: apply (var "capitalize") (string "arthur") -apply :: Term -> Term -> Term -apply fun arg = TermApplication $ Application fun arg - --- | Create a bigint literal --- Example: bigint 9223372036854775808 -bigint :: Integer -> Term -bigint = literal . Literals.bigint - --- | Create a binary data literal from a ByteString. --- Example: binary (B.pack [0x48, 0x65, 0x00, 0xff, 0x20, 0x7a, 0x1b, 0x80]) -binary :: B.ByteString -> Term -binary = literal . Literals.binary - --- | Create a boolean literal --- Example: boolean True -boolean :: Bool -> Term -boolean = literal . Literals.boolean - -char :: Char -> Term -char = int32 . C.ord - -comparison :: Comparison -> Term -comparison t = case t of - ComparisonEqualTo -> injectUnit _Comparison _Comparison_equalTo - ComparisonLessThan -> injectUnit _Comparison _Comparison_lessThan - ComparisonGreaterThan -> injectUnit _Comparison _Comparison_greaterThan - --- | Compose two functions (apply g then f) to create a new function --- Example: compose (var "stringLength") (var "toString") --- This creates a function equivalent to \x -> stringLength(toString(x)) --- Function composition applies right-to-left: (f ∘ g)(x) = f(g(x)) -compose :: Term -> Term -> Term -compose f g = lambda "arg_" $ apply f (apply g $ var "arg_") - --- | Create a constant function that always returns the same value --- Example: constant true -constant :: Term -> Term -constant = lambda ignoredVariable - --- | Create an arbitrary-precision decimal literal. --- Example: decimal (Sci.scientific 314159265359 (-11)) -decimal :: Sci.Scientific -> Term -decimal = literal . Literals.decimal - --- | Boolean false literal -false :: Term -false = boolean False - --- | Create a field with the given name and value --- Example: field "age" (int32 30) -field :: String -> Term -> Field -field n = Field (Name n) - --- | First element projection function for pairs -first :: Term -first = primitive $ Name "hydra.lib.pairs.first" - --- | Create a floating-point literal with specified precision --- Example: float (FloatValueFloat32 3.14) -float :: FloatValue -> Term -float = literal . Literals.float - --- | Create a float32 literal --- Example: float32 3.14 -float32 :: Float -> Term -float32 = literal . Literals.float32 - --- | Create a float64 literal --- Example: float64 3.14159265359 -float64 :: Double -> Term -float64 = literal . Literals.float64 - --- | Identity function -identity :: Term -identity = lambda "x_" $ var "x_" - --- | Create a union value by injecting a value into a specific variant --- Example: inject (Name "Result") (Name "success") (int32 42) --- This creates a "Result" union with the "success" variant containing value 42 --- Use this to construct values of union types at runtime -inject :: Name -> Name -> Term -> Term -inject tname fname term = TermInject $ Injection tname $ Field fname term - --- | Create a unit variant of a union (convenience function) --- Example: injectUnit (Name "Result") (Name "success") --- Equivalent to inject but automatically uses unit as the value -injectUnit :: Name -> Name -> Term -injectUnit tname fname = inject tname fname unit - --- | Create an int16 literal --- Example: int16 32767 -int16 :: Int16 -> Term -int16 = literal . Literals.int16 - --- | Create an int32 literal --- Example: int32 42 -int32 :: Int -> Term -int32 = literal . Literals.int32 - --- | Create an int64 literal --- Example: int64 9223372036854775807 -int64 :: Int64 -> Term -int64 = literal . Literals.int64 - --- | Create an int8 literal --- Example: int8 127 -int8 :: Int8 -> Term -int8 = literal . Literals.int8 - --- | Create an integer literal with specified bit width --- Example: integer (IntegerValueInt32 42) -integer :: IntegerValue -> Term -integer = literal . Literals.integer - --- | Create a 'Just' optional value --- Example: just (string "found") -just :: Term -> Term -just = optional . Just - --- | Create a lambda function with one parameter --- Example: lambda "x" (var "x" @@ int32 1) -lambda :: String -> Term -> Term -lambda param body = TermLambda $ Lambda (Name param) Nothing body - --- | Create a lambda function with a given domain --- Example: lambdaTyped "x" Types.int32 (list [var "x"]) -lambdaTyped :: String -> Type -> Term -> Term -lambdaTyped param dom body = TermLambda $ Lambda (Name param) (Just dom) body - --- | Create a multi-parameter lambda function (curried) --- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y") --- This creates the function \x.\y.add x y -lambdas :: [String] -> Term -> Term -lambdas params body = case params of - [] -> body - (h:r) -> lambda h $ lambdas r body - --- | Create a 'Left' either value --- Example: left (string "error") -left :: Term -> Term -left term = TermEither (Left term) - --- | Create a let term with any number of bindings --- Example: lets ["x">: int32 1, "y">: int32 2] (pair (var "x") (var "y")) -lets :: [Field] -> Term -> Term -lets bindings env = TermLet $ Let (toBinding <$> bindings) env - where - toBinding (Field name value) = Binding name value Nothing - -letsTyped :: [(String, Term, TypeScheme)] -> Term -> Term -letsTyped bindings env = TermLet $ Let (toBinding <$> bindings) env - where - toBinding (name, value, ts) = Binding (Name name) value (Just ts) - --- | Create a list of terms --- Example: list [int32 1, int32 2, int32 3] -list :: [Term] -> Term -list = TermList - --- | Create a term from a literal value --- Example: literal (LiteralString "hello") -literal :: Literal -> Term -literal = TermLiteral - --- | Create a map/dictionary term --- Example: map (M.fromList [(string "January", int32 31), (string "February", int32 28)]) -map :: M.Map Term Term -> Term -map = TermMap - --- | Create a pattern match on a union type --- Example: match (Name "Result") (Just (string "unknown")) --- ["success">: lambda "s" (var "processSuccess" @@ var "s"), --- "error">: lambda "e" (var "handleError" @@ var "e")] --- This allows handling different cases of a union type with specific logic for each variant. --- The optional second parameter provides a default case for any unmatched variants. -match :: Name -> Maybe Term -> [Field] -> Term -match tname def fields = TermCases $ CaseStatement tname def (fieldToCaseAlternative <$> fields) - where - -- The DSL builds case alternatives via the same >>: operator used for record/union - -- fields, so call sites still pass [Field]; convert each to a CaseAlternative here. - fieldToCaseAlternative (Field fname fterm) = CaseAlternative fname fterm - --- | Create a 'Nothing' optional value -nothing :: Term -nothing = optional Nothing - --- | Create a Maybe (nullable) term --- Example: optional (Just (string "found")) -optional :: Maybe Term -> Term -optional = TermOptional - --- | Create a pair --- Example: pair (string "name") (int32 42) -pair :: Term -> Term -> Term -pair a b = TermPair (a, b) - --- | Create a reference to a primitive function. --- | Things that name a primitive. Lets the term/DSL helpers take a generated --- 'PrimitiveDefinition' directly (@primitive DefStrings.toUpper@) — keeping the def-modules the --- single source of truth for primitive names (#473) — while still accepting a raw 'Name'. --- Defined here (the lowest DSL module) so 'Hydra.Dsl.Prims', 'Hydra.Dsl.Meta.Terms', and --- 'Hydra.Dsl.Meta.Phantoms' can all share one class without an import cycle. -class ToPrimName a where - toPrimName :: a -> Name - -instance ToPrimName Name where - toPrimName = id - -instance ToPrimName PrimitiveDefinition where - toPrimName = primitiveDefinitionName - --- Uses TermVariable; the name resolves via graphPrimitives fallthrough. --- Example: primitive DefStrings.length -primitive :: ToPrimName n => n -> Term -primitive = TermVariable . toPrimName - --- | Create a field projection function --- Example: project (Name "Person") (Name "firstName") -project :: Name -> Name -> Term -project tname fname = TermProject $ Projection tname fname - --- | Create a record with named fields of the specified type --- Example: record (Name "Person") [ --- "name">: string "John", --- "age">: int32 30, --- "email">: string "john@example.com"] --- Records are products of named fields with values that can be accessed by field name -record :: Name -> [Field] -> Term -record tname fields = TermRecord $ Record tname fields - --- | Create a 'Right' either value --- Example: right (int32 42) -right :: Term -> Term -right term = TermEither (Right term) - --- | Second element projection function for pairs -second :: Term -second = primitive $ Name "hydra.lib.pairs.second" - --- | Create a set of terms --- Example: set (S.fromList [string "a", string "b", string "c"]) -set :: S.Set Term -> Term -set = TermSet - --- | Create a string literal --- Example: string "hello world" -string :: String -> Term -string = TermLiteral . LiteralString - -triple :: Term -> Term -> Term -> Term -triple a b c = pair a (pair b c) - --- | Boolean true literal -true :: Term -true = boolean True - --- | Create a tuple using nested pairs (deprecated: use pair directly) --- Example: tuple2 a b creates pair a b --- Example: tuple3 a b c creates pair a (pair b c) -tuple :: [Term] -> Term -tuple [] = unit -tuple [a] = a -tuple [a, b] = pair a b -tuple (a:rest) = pair a (tuple rest) - --- | Create a 2-tuple (same as pair) -tuple2 :: Term -> Term -> Term -tuple2 = pair - -tuple3 :: Term -> Term -> Term -> Term -tuple3 a b c = pair a (pair b c) - -tuple4 :: Term -> Term -> Term -> Term -> Term -tuple4 a b c d = pair a (pair b (pair c d)) - -tuple5 :: Term -> Term -> Term -> Term -> Term -> Term -tuple5 a b c d e = pair a (pair b (pair c (pair d e))) - -tyapp :: Term -> Type -> Term -tyapp term typ = TermTypeApplication $ TypeApplicationTerm term typ - -tyapps = typeApplication - -tylam :: String -> Term -> Term -tylam var body = TermTypeLambda $ TypeLambda (Name var) body - -tylams :: [String] -> Term -> Term -tylams vars body = L.foldl (\b v -> TermTypeLambda $ TypeLambda (Name v) b) body $ L.reverse vars - --- | Apply type arguments to a polymorphic term --- Example: typeApplication (var "map") [Types.int32, Types.string] --- This instantiates a polymorphic function with concrete types. --- For instance, if 'map' has type 'forall a b. (a -> b) -> list a -> list b', --- the example would instantiate it to '(int32 -> string) -> list int32 -> list string'. -typeApplication :: Term -> [Type] -> Term -typeApplication term types = L.foldl (\t ty -> TermTypeApplication $ TypeApplicationTerm t ty) term types - --- | Create a type abstraction (universal quantification) --- Example: typeLambda [Name "a", Name "b"] (lambdaTyped "f" (Types.function (Types.var "a") (Types.var "b")) --- (lambdaTyped "x" (Types.var "a") (var "f" @@ var "x"))) --- This creates a polymorphic term with type variables. --- The example creates a higher-order function with type 'forall a b. (a -> b) -> a -> b', --- which is the polymorphic apply function that works for any types a and b. -typeLambda :: [Name] -> Term -> Term -typeLambda vars body = L.foldl (\b v -> TermTypeLambda $ TypeLambda v b) body vars - --- | Create a uint16 literal --- Example: uint16 65535 -uint16 :: Int -> Term -uint16 = literal . Literals.uint16 - --- | Create a uint32 literal --- Example: uint32 4294967295 -uint32 :: Int64 -> Term -uint32 = literal . Literals.uint32 - --- | Create a uint64 literal --- Example: uint64 18446744073709551615 -uint64 :: Integer -> Term -uint64 = literal . Literals.uint64 - --- | Create a uint8 literal --- Example: uint8 255 -uint8 :: Int16 -> Term -uint8 = literal . Literals.uint8 - --- | Unit value (empty record) -unit :: Term -unit = TermUnit - --- | Create an unwrap function for a wrapped type --- Example: unwrap (Name "Email") -unwrap :: Name -> Term -unwrap = TermUnwrap - --- | Create a variable reference --- Example: var "x" -var :: String -> Term -var = TermVariable . Name - --- | Create a wrapped term --- Example: wrap (Name "Email") (string "user@example.com") -wrap :: Name -> Term -> Term -wrap name term = TermWrap $ WrappedTerm name term 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 @@ -1,19 +1,97 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.testing module Hydra.Dsl.Testing where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Testing as Testing import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + +-- | DSL constructor for hydra.testing.EffectfulTestCase +effectfulTestCase :: Typed.TypedTerm (() -> IO String) -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.EffectfulTestCase +effectfulTestCase actual expected = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "actual"), + Core.fieldTerm = (Typed.unTypedTerm actual)}, + Core.Field { + Core.fieldName = (Core.Name "expected"), + Core.fieldTerm = (Typed.unTypedTerm expected)}]})) + +-- | DSL accessor for the actual field of hydra.testing.EffectfulTestCase +effectfulTestCaseActual :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm (() -> IO String) +effectfulTestCaseActual x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.projectionFieldName = (Core.Name "actual")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the expected field of hydra.testing.EffectfulTestCase +effectfulTestCaseExpected :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm (() -> String) +effectfulTestCaseExpected x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.projectionFieldName = (Core.Name "expected")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the actual field of hydra.testing.EffectfulTestCase +effectfulTestCaseWithActual :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm (() -> IO String) -> Typed.TypedTerm Testing.EffectfulTestCase +effectfulTestCaseWithActual original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "actual"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "expected"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.projectionFieldName = (Core.Name "expected")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + +-- | DSL updater for the expected field of hydra.testing.EffectfulTestCase +effectfulTestCaseWithExpected :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.EffectfulTestCase +effectfulTestCaseWithExpected original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "actual"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.testing.EffectfulTestCase"), + Core.projectionFieldName = (Core.Name "actual")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "expected"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for the hydra.testing.Tag wrapper tag :: Typed.TypedTerm String -> Typed.TypedTerm Testing.Tag tag x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.testing.Tag"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + +-- | DSL injection for the effectful variant of hydra.testing.TestCase +testCaseEffectful :: Typed.TypedTerm Testing.EffectfulTestCase -> Typed.TypedTerm Testing.TestCase +testCaseEffectful x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.testing.TestCase"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "effectful"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the universal variant of hydra.testing.TestCase testCaseUniversal :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm Testing.TestCase testCaseUniversal x = @@ -22,6 +100,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "universal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.testing.TestCaseWithMetadata testCaseWithMetadata :: Typed.TypedTerm String -> Typed.TypedTerm Testing.TestCase -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm [Testing.Tag] -> Typed.TypedTerm Testing.TestCaseWithMetadata testCaseWithMetadata name case_ description tags = @@ -40,6 +119,7 @@ Core.Field { Core.fieldName = (Core.Name "tags"), Core.fieldTerm = (Typed.unTypedTerm tags)}]})) + -- | DSL accessor for the case field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataCase :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm Testing.TestCase testCaseWithMetadataCase x = @@ -48,6 +128,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "case")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the description field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataDescription :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm (Maybe String) testCaseWithMetadataDescription x = @@ -56,6 +137,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataName :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm String testCaseWithMetadataName x = @@ -64,6 +146,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the tags field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataTags :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm [Testing.Tag] testCaseWithMetadataTags x = @@ -72,6 +155,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "tags")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -102,6 +186,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "tags")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the description field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataWithDescription :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Testing.TestCaseWithMetadata testCaseWithMetadataWithDescription original newVal = @@ -132,6 +217,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "tags")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataWithName :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm String -> Typed.TypedTerm Testing.TestCaseWithMetadata testCaseWithMetadataWithName original newVal = @@ -162,6 +248,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestCaseWithMetadata"), Core.projectionFieldName = (Core.Name "tags")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the tags field of hydra.testing.TestCaseWithMetadata testCaseWithMetadataWithTags :: Typed.TypedTerm Testing.TestCaseWithMetadata -> Typed.TypedTerm [Testing.Tag] -> Typed.TypedTerm Testing.TestCaseWithMetadata testCaseWithMetadataWithTags original newVal = @@ -192,6 +279,7 @@ Core.Field { Core.fieldName = (Core.Name "tags"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.testing.TestGroup testGroup :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm [Testing.TestGroup] -> Typed.TypedTerm [Testing.TestCaseWithMetadata] -> Typed.TypedTerm Testing.TestGroup testGroup name description subgroups cases = @@ -210,6 +298,7 @@ Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm cases)}]})) + -- | DSL accessor for the cases field of hydra.testing.TestGroup testGroupCases :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm [Testing.TestCaseWithMetadata] testGroupCases x = @@ -218,6 +307,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the description field of hydra.testing.TestGroup testGroupDescription :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm (Maybe String) testGroupDescription x = @@ -226,6 +316,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.testing.TestGroup testGroupName :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm String testGroupName x = @@ -234,6 +325,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the subgroups field of hydra.testing.TestGroup testGroupSubgroups :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm [Testing.TestGroup] testGroupSubgroups x = @@ -242,6 +334,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "subgroups")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -272,6 +365,7 @@ Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the description field of hydra.testing.TestGroup testGroupWithDescription :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Testing.TestGroup testGroupWithDescription original newVal = @@ -302,6 +396,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the name field of hydra.testing.TestGroup testGroupWithName :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm String -> Typed.TypedTerm Testing.TestGroup testGroupWithName original newVal = @@ -332,6 +427,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the subgroups field of hydra.testing.TestGroup testGroupWithSubgroups :: Typed.TypedTerm Testing.TestGroup -> Typed.TypedTerm [Testing.TestGroup] -> Typed.TypedTerm Testing.TestGroup testGroupWithSubgroups original newVal = @@ -362,12 +458,14 @@ Core.projectionTypeName = (Core.Name "hydra.testing.TestGroup"), Core.projectionFieldName = (Core.Name "cases")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL accessor for the body of hydra.testing.Tag unTag :: Typed.TypedTerm Testing.Tag -> Typed.TypedTerm String unTag x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.testing.Tag")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.testing.UniversalTestCase universalTestCase :: Typed.TypedTerm (() -> String) -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.UniversalTestCase universalTestCase actual expected = @@ -380,6 +478,7 @@ Core.Field { Core.fieldName = (Core.Name "expected"), Core.fieldTerm = (Typed.unTypedTerm expected)}]})) + -- | DSL accessor for the actual field of hydra.testing.UniversalTestCase universalTestCaseActual :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm (() -> String) universalTestCaseActual x = @@ -388,6 +487,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.UniversalTestCase"), Core.projectionFieldName = (Core.Name "actual")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the expected field of hydra.testing.UniversalTestCase universalTestCaseExpected :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm (() -> String) universalTestCaseExpected x = @@ -396,6 +496,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.UniversalTestCase"), Core.projectionFieldName = (Core.Name "expected")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the actual field of hydra.testing.UniversalTestCase universalTestCaseWithActual :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.UniversalTestCase universalTestCaseWithActual original newVal = @@ -412,6 +513,7 @@ Core.projectionTypeName = (Core.Name "hydra.testing.UniversalTestCase"), Core.projectionFieldName = (Core.Name "expected")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the expected field of hydra.testing.UniversalTestCase universalTestCaseWithExpected :: Typed.TypedTerm Testing.UniversalTestCase -> Typed.TypedTerm (() -> String) -> Typed.TypedTerm Testing.UniversalTestCase universalTestCaseWithExpected original newVal = diff --git a/src/main/haskell/Hydra/Dsl/Tests.hs b/src/main/haskell/Hydra/Dsl/Tests.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Tests.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | Convenience functions for writing Hydra test cases - -module Hydra.Dsl.Tests ( - module Hydra.Testing, - module Hydra.Dsl.Libraries, - module Hydra.Dsl.Terms, - module Hydra.Dsl.Tests, -) where - -import Hydra.Core -import Hydra.Testing -import Hydra.Dsl.Libraries -import Hydra.Dsl.Terms - -import qualified Data.List as L -import qualified Data.Set as S - - -intList :: [Int] -> Term -intList els = list (int32 <$> els) - -intListList :: [[Int]] -> Term -intListList lists = list (intList <$> lists) - -stringList :: [String] -> Term -stringList els = list (string <$> els) - -stringSet :: S.Set String -> Term -stringSet strings = set $ S.fromList $ string <$> S.toList strings diff --git a/src/main/haskell/Hydra/Dsl/Time.hs b/src/main/haskell/Hydra/Dsl/Time.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Time.hs @@ -0,0 +1,78 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | DSL functions for hydra.time + +module Hydra.Dsl.Time where + +import qualified Hydra.Core as Core +import qualified Hydra.Dsl.Core as DslCore +import qualified Hydra.Time as Time +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.Int as I + +-- | DSL constructor for hydra.time.Timespec +timespec :: Typed.TypedTerm I.Int64 -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm Time.Timespec +timespec seconds nanoseconds = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.time.Timespec"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "seconds"), + Core.fieldTerm = (Typed.unTypedTerm seconds)}, + Core.Field { + Core.fieldName = (Core.Name "nanoseconds"), + Core.fieldTerm = (Typed.unTypedTerm nanoseconds)}]})) + +-- | DSL accessor for the nanoseconds field of hydra.time.Timespec +timespecNanoseconds :: Typed.TypedTerm Time.Timespec -> Typed.TypedTerm I.Int64 +timespecNanoseconds x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.time.Timespec"), + Core.projectionFieldName = (Core.Name "nanoseconds")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL accessor for the seconds field of hydra.time.Timespec +timespecSeconds :: Typed.TypedTerm Time.Timespec -> Typed.TypedTerm I.Int64 +timespecSeconds x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.time.Timespec"), + Core.projectionFieldName = (Core.Name "seconds")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the nanoseconds field of hydra.time.Timespec +timespecWithNanoseconds :: Typed.TypedTerm Time.Timespec -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm Time.Timespec +timespecWithNanoseconds original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.time.Timespec"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "seconds"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.time.Timespec"), + Core.projectionFieldName = (Core.Name "seconds")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}, + Core.Field { + Core.fieldName = (Core.Name "nanoseconds"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + +-- | DSL updater for the seconds field of hydra.time.Timespec +timespecWithSeconds :: Typed.TypedTerm Time.Timespec -> Typed.TypedTerm I.Int64 -> Typed.TypedTerm Time.Timespec +timespecWithSeconds original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.time.Timespec"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "seconds"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}, + Core.Field { + Core.fieldName = (Core.Name "nanoseconds"), + Core.fieldTerm = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.time.Timespec"), + Core.projectionFieldName = (Core.Name "nanoseconds")})), + Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.topology module Hydra.Dsl.Topology where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Topology as Topology @@ -10,6 +12,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | DSL constructor for hydra.topology.OrderingIsomorphism orderingIsomorphism :: Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm (Topology.OrderingIsomorphism a) orderingIsomorphism encode decode = @@ -22,6 +25,7 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm decode)}]})) + -- | DSL accessor for the decode field of hydra.topology.OrderingIsomorphism orderingIsomorphismDecode :: Typed.TypedTerm (Topology.OrderingIsomorphism a) -> Typed.TypedTerm ([a] -> [a]) orderingIsomorphismDecode x = @@ -30,6 +34,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.OrderingIsomorphism"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the encode field of hydra.topology.OrderingIsomorphism orderingIsomorphismEncode :: Typed.TypedTerm (Topology.OrderingIsomorphism a) -> Typed.TypedTerm ([a] -> [a]) orderingIsomorphismEncode x = @@ -38,6 +43,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.OrderingIsomorphism"), Core.projectionFieldName = (Core.Name "encode")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -54,6 +60,7 @@ Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the encode field of hydra.topology.OrderingIsomorphism orderingIsomorphismWithEncode :: Typed.TypedTerm (Topology.OrderingIsomorphism a) -> Typed.TypedTerm ([a] -> [a]) -> Typed.TypedTerm (Topology.OrderingIsomorphism a) orderingIsomorphismWithEncode original newVal = @@ -70,6 +77,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.OrderingIsomorphism"), Core.projectionFieldName = (Core.Name "decode")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.topology.TarjanState tarjanState :: Typed.TypedTerm Int -> Typed.TypedTerm (M.Map Topology.Vertex Int) -> Typed.TypedTerm (M.Map Topology.Vertex Int) -> Typed.TypedTerm [Topology.Vertex] -> Typed.TypedTerm (S.Set Topology.Vertex) -> Typed.TypedTerm [[Topology.Vertex]] -> Typed.TypedTerm Topology.TarjanState tarjanState counter indices lowLinks stack onStack sccs = @@ -94,6 +102,7 @@ Core.Field { Core.fieldName = (Core.Name "sccs"), Core.fieldTerm = (Typed.unTypedTerm sccs)}]})) + -- | DSL accessor for the counter field of hydra.topology.TarjanState tarjanStateCounter :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm Int tarjanStateCounter x = @@ -102,6 +111,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "counter")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the indices field of hydra.topology.TarjanState tarjanStateIndices :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (M.Map Topology.Vertex Int) tarjanStateIndices x = @@ -110,6 +120,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "indices")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the lowLinks field of hydra.topology.TarjanState tarjanStateLowLinks :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (M.Map Topology.Vertex Int) tarjanStateLowLinks x = @@ -118,6 +129,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "lowLinks")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the onStack field of hydra.topology.TarjanState tarjanStateOnStack :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (S.Set Topology.Vertex) tarjanStateOnStack x = @@ -126,6 +138,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "onStack")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the sccs field of hydra.topology.TarjanState tarjanStateSccs :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm [[Topology.Vertex]] tarjanStateSccs x = @@ -134,6 +147,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "sccs")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the stack field of hydra.topology.TarjanState tarjanStateStack :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm [Topology.Vertex] tarjanStateStack x = @@ -142,6 +156,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "stack")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the counter field of hydra.topology.TarjanState tarjanStateWithCounter :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm Int -> Typed.TypedTerm Topology.TarjanState tarjanStateWithCounter original newVal = @@ -186,6 +201,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "sccs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the indices field of hydra.topology.TarjanState tarjanStateWithIndices :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (M.Map Topology.Vertex Int) -> Typed.TypedTerm Topology.TarjanState tarjanStateWithIndices original newVal = @@ -230,6 +246,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "sccs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the lowLinks field of hydra.topology.TarjanState tarjanStateWithLowLinks :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (M.Map Topology.Vertex Int) -> Typed.TypedTerm Topology.TarjanState tarjanStateWithLowLinks original newVal = @@ -274,6 +291,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "sccs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the onStack field of hydra.topology.TarjanState tarjanStateWithOnStack :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm (S.Set Topology.Vertex) -> Typed.TypedTerm Topology.TarjanState tarjanStateWithOnStack original newVal = @@ -318,6 +336,7 @@ Core.projectionTypeName = (Core.Name "hydra.topology.TarjanState"), Core.projectionFieldName = (Core.Name "sccs")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the sccs field of hydra.topology.TarjanState tarjanStateWithSccs :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm [[Topology.Vertex]] -> Typed.TypedTerm Topology.TarjanState tarjanStateWithSccs original newVal = @@ -362,6 +381,7 @@ Core.Field { Core.fieldName = (Core.Name "sccs"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the stack field of hydra.topology.TarjanState tarjanStateWithStack :: Typed.TypedTerm Topology.TarjanState -> Typed.TypedTerm [Topology.Vertex] -> Typed.TypedTerm Topology.TarjanState tarjanStateWithStack original newVal = diff --git a/src/main/haskell/Hydra/Dsl/Types.hs b/src/main/haskell/Hydra/Dsl/Types.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Dsl/Types.hs +++ /dev/null @@ -1,266 +0,0 @@ --- | A domain-specific language for constructing Hydra types in Haskell. -module Hydra.Dsl.Types where - -import Prelude hiding (product) - -import Hydra.Core -import Hydra.Dsl.AsType -import Hydra.Dsl.Meta.Common -import qualified Hydra.Dsl.Terms as Terms - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S - - --- Operators - --- | Function type constructor with infix syntax --- Example: int32 ~> string --- Use this for more readable function type definitions -infixr 0 ~> -(~>) :: (AsType a, AsType b) => a -> b -> Type -dom ~> cod = function (asType dom) (asType cod) - --- | Function type constructor with infix syntax (deprecated, use ~> instead) --- Example: int32 --> string -infixr 0 --> -(-->) :: (AsType a, AsType b) => a -> b -> Type -dom --> cod = function (asType dom) (asType cod) - --- | Type application operator --- Example: list @@ int32 -(@@) :: (AsType a, AsType b) => a -> b -> Type -fun @@ arg = apply (asType fun) (asType arg) - --- | Field definition operator --- Example: "name">: string -infixr 0 >: -(>:) :: AsType a => String -> a -> FieldType -name>: typ = field name (asType typ) - - --- | Attach an annotation map to a type, wrapping the map as a TermMap per --- Hydra's convention (#386 — annotation is now a Term, not a Map). --- Example: annot (M.fromList [(Name "min", int32 0), (Name "max", int32 100)]) int32 -annot :: AsType a => M.Map Name Term -> a -> Type -annot ann typ = TypeAnnotated $ AnnotatedType (asType typ) (Terms.annotationMapAsTerm ann) - --- | Apply a type to a type argument --- Example: apply (var "f") int32 -apply :: (AsType a, AsType b) => a -> b -> Type -apply lhs rhs = TypeApplication (ApplicationType (asType lhs) (asType rhs)) - --- | Apply a type to multiple type arguments --- Example: applys (var "Either") [string, int32] -applys :: AsType a => a -> [Type] -> Type -applys t ts = L.foldl apply (asType t) ts - --- | Arbitrary-precision integer type -bigint :: Type -bigint = integer IntegerTypeBigint - --- | Binary data type -binary :: Type -binary = literal LiteralTypeBinary - --- | Boolean type -boolean :: Type -boolean = literal LiteralTypeBoolean - --- | Arbitrary-precision decimal type -decimal :: Type -decimal = literal LiteralTypeDecimal - --- | Create an either type (a choice between two types) --- Example: either_ string int32 -either_ :: (AsType a, AsType b) => a -> b -> Type -either_ left right = TypeEither $ EitherType (asType left) (asType right) - --- | Create an enum type with the given variant names (conventionally in camelCase) --- Example: enum ["red", "green", "blue"] -enum :: [String] -> Type -enum names = union $ (`field` unit) <$> names - --- | Create a field with the given name and type --- Example: field "age" int32 -field :: AsType a => String -> a -> FieldType -field fn t = FieldType (Name fn) (asType t) - --- | Create a floating point type with the specified precision --- Example: float FloatTypeFloat32 -float :: FloatType -> Type -float = literal . LiteralTypeFloat - --- | 32-bit floating point type -float32 :: Type -float32 = float FloatTypeFloat32 - --- | 64-bit floating point type -float64 :: Type -float64 = float FloatTypeFloat64 - --- | Create a universally quantified type (polymorphic type) with a singe variable --- Example: forAll "a" (var "a" --> var "a") --- This creates the polymorphic identity function type: ∀a. a -> a --- Universal quantification introduces type variables that can be used in the body -forAll :: AsType a => String -> a -> Type -forAll v body = TypeForall $ ForallType (Name v) (asType body) - --- | Universal quantification with multiple variables --- Example: forAlls ["a", "b"] (var "a" --> var "b") -forAlls :: AsType a => [String] -> a -> Type -forAlls vs body = L.foldr forAll (asType body) vs - --- | Create a function type --- Example: function int32 string -function :: (AsType a, AsType b) => a -> b -> Type -function dom cod = TypeFunction $ FunctionType (asType dom) (asType cod) - --- | Create an n-ary function type --- Example: functionMany [int32, string, boolean] -functionMany :: [Type] -> Type -functionMany ts = L.foldl (\cod dom -> function dom cod) (L.head r) (L.tail r) - where - r = L.reverse ts - --- | 16-bit signed integer type -int16 :: Type -int16 = integer IntegerTypeInt16 - --- | 32-bit signed integer type -int32 :: Type -int32 = integer IntegerTypeInt32 - --- | 64-bit signed integer type -int64 :: Type -int64 = integer IntegerTypeInt64 - --- | 8-bit signed integer type -int8 :: Type -int8 = integer IntegerTypeInt8 - --- | Create an integer type with the specified bit width --- Example: integer IntegerTypeInt32 -integer :: IntegerType -> Type -integer = literal . LiteralTypeInteger - --- | List type --- Example: list string -list :: AsType a => a -> Type -list = TypeList . asType - --- | Literal primitive type --- Example: literal LiteralTypeString -literal :: LiteralType -> Type -literal = TypeLiteral - --- | Map/dictionary type with key and value types --- Example: map string int32 -map :: (AsType a, AsType b) => a -> b -> Type -map keys vals = TypeMap $ MapType (asType keys) (asType vals) - --- | Create a monomorphic type scheme --- Example: mono int32 -mono :: AsType a => a -> TypeScheme -mono t = TypeScheme [] (asType t) Nothing - --- | Non-negative 32-bit integer type --- Currently an alias for int32; intended for semantic annotation --- In future versions, this may include validation constraints -nonNegativeInt32 :: Type -nonNegativeInt32 = int32 - --- | Optional (nullable) type --- Example: optional string -optional :: AsType a => a -> Type -optional = TypeOptional . asType - --- | Create a pair type --- Example: pair string int32 -pair :: (AsType a, AsType b) => a -> b -> Type -pair first second = TypePair $ PairType (asType first) (asType second) - --- | Create a polymorphic type scheme with explicit type variables --- Example: poly ["a", "b"] (var "a" --> var "b") --- This represents a type forall a b. a -> b that can be instantiated with different types -poly :: AsType a => [String] -> a -> TypeScheme -poly vs t = TypeScheme (Name <$> vs) (asType t) Nothing - --- | Create a polymorphic type scheme with explicit type variables and constraints --- Example: polyConstrained [("a", [Name "hydra.core.Eq"])] (var "a" --> var "a" --> boolean) --- This represents a type forall a. (Eq a) => a -> a -> Boolean -polyConstrained :: AsType a => [(String, [Name])] -> a -> TypeScheme -polyConstrained vsWithConstraints t = TypeScheme vars (asType t) (Just constraintMap) - where - vars = Name . fst <$> vsWithConstraints - constraintMap = M.fromList - [(Name v, TypeVariableConstraints (TypeClassConstraintSimple <$> classes)) | (v, classes) <- vsWithConstraints, not (L.null classes)] - --- | Create a product type using nested pairs (deprecated: use pair directly) --- Example: product [string, int32, boolean] creates pair string (pair int32 boolean) -product :: [Type] -> Type -product [] = unit -product [a] = a -product [a, b] = pair a b -product (a:rest) = pair a (product rest) - --- | Create a record type with the given fields --- Example: record ["name">: string, "age">: int32] -record :: [FieldType] -> Type -record = TypeRecord - --- | Set type --- Example: set string -set :: AsType a => a -> Type -set = TypeSet . asType - --- | String type -string :: Type -string = literal LiteralTypeString - --- | 16-bit unsigned integer type -uint16 :: Type -uint16 = integer IntegerTypeUint16 - --- | 32-bit unsigned integer type -uint32 :: Type -uint32 = integer IntegerTypeUint32 - --- | 64-bit unsigned integer type -uint64 :: Type -uint64 = integer IntegerTypeUint64 - --- | 8-bit unsigned integer type -uint8 :: Type -uint8 = integer IntegerTypeUint8 - --- | Create a union type with the given variants --- Example: union ["success">: int32, "failure">: string] --- This creates a tagged union type (sum type with named variants) --- Similar to sum [int32, string] but with named branches -union :: [FieldType] -> Type -union = TypeUnion - --- | Unit type (empty record type) -unit :: Type -unit = TypeUnit - --- | Create a type variable with the given name (alias for 'variable') --- Example: var "a" -var :: String -> Type -var = variable - --- | Create a type variable with the given name --- Example: variable "a" -variable :: String -> Type -variable = TypeVariable . Name - --- | Void type (uninhabited / bottom type) -void :: Type -void = TypeVoid - --- | Create a wrapped type (newtype) with a provided base type --- Example: wrap string -wrap :: AsType a => a -> Type -wrap = TypeWrap . asType 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.typing module Hydra.Dsl.Typing where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Paths as DslPaths @@ -11,6 +13,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | 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 = @@ -38,6 +41,7 @@ Core.Field { Core.fieldName = (Core.Name "environment"), Core.fieldTerm = (Typed.unTypedTerm environment)}]})) + -- | DSL accessor for the bindings field of hydra.typing.FunctionStructure functionStructureBindings :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Binding] functionStructureBindings x = @@ -46,6 +50,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "bindings")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body field of hydra.typing.FunctionStructure functionStructureBody :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm Core.Term functionStructureBody x = @@ -54,6 +59,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "body")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the codomain field of hydra.typing.FunctionStructure functionStructureCodomain :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm (Maybe Core.Type) functionStructureCodomain x = @@ -62,6 +68,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "codomain")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the domains field of hydra.typing.FunctionStructure functionStructureDomains :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Type] functionStructureDomains x = @@ -70,6 +77,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "domains")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the environment field of hydra.typing.FunctionStructure functionStructureEnvironment :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm env functionStructureEnvironment x = @@ -78,6 +86,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the params field of hydra.typing.FunctionStructure functionStructureParams :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Name] functionStructureParams x = @@ -86,6 +95,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "params")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeParams field of hydra.typing.FunctionStructure functionStructureTypeParams :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Name] functionStructureTypeParams x = @@ -94,6 +104,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "typeParams")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the bindings field of hydra.typing.FunctionStructure functionStructureWithBindings :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Binding] -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithBindings original newVal = @@ -145,6 +156,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the body field of hydra.typing.FunctionStructure functionStructureWithBody :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithBody original newVal = @@ -196,6 +208,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the codomain field of hydra.typing.FunctionStructure functionStructureWithCodomain :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm (Maybe Core.Type) -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithCodomain original newVal = @@ -247,6 +260,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the domains field of hydra.typing.FunctionStructure functionStructureWithDomains :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithDomains original newVal = @@ -298,6 +312,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the environment field of hydra.typing.FunctionStructure functionStructureWithEnvironment :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm env -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithEnvironment original newVal = @@ -349,6 +364,7 @@ Core.Field { Core.fieldName = (Core.Name "environment"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the params field of hydra.typing.FunctionStructure functionStructureWithParams :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithParams original newVal = @@ -400,6 +416,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the typeParams field of hydra.typing.FunctionStructure functionStructureWithTypeParams :: Typed.TypedTerm (Typing.FunctionStructure env) -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm (Typing.FunctionStructure env) functionStructureWithTypeParams original newVal = @@ -451,6 +468,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.FunctionStructure"), Core.projectionFieldName = (Core.Name "environment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.typing.InferenceContext inferenceContext :: Typed.TypedTerm Int -> Typed.TypedTerm [Paths.SubtermStep] -> Typed.TypedTerm Typing.InferenceContext inferenceContext freshTypeVariableCount trace = @@ -463,6 +481,7 @@ Core.Field { Core.fieldName = (Core.Name "trace"), Core.fieldTerm = (Typed.unTypedTerm trace)}]})) + -- | DSL accessor for the freshTypeVariableCount field of hydra.typing.InferenceContext inferenceContextFreshTypeVariableCount :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Int inferenceContextFreshTypeVariableCount x = @@ -471,6 +490,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceContext"), Core.projectionFieldName = (Core.Name "freshTypeVariableCount")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the trace field of hydra.typing.InferenceContext inferenceContextTrace :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm [Paths.SubtermStep] inferenceContextTrace x = @@ -479,6 +499,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceContext"), Core.projectionFieldName = (Core.Name "trace")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the freshTypeVariableCount field of hydra.typing.InferenceContext inferenceContextWithFreshTypeVariableCount :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Int -> Typed.TypedTerm Typing.InferenceContext inferenceContextWithFreshTypeVariableCount original newVal = @@ -495,6 +516,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceContext"), Core.projectionFieldName = (Core.Name "trace")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the trace field of hydra.typing.InferenceContext inferenceContextWithTrace :: Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm [Paths.SubtermStep] -> Typed.TypedTerm Typing.InferenceContext inferenceContextWithTrace original newVal = @@ -511,6 +533,7 @@ Core.Field { Core.fieldName = (Core.Name "trace"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.typing.InferenceResult inferenceResult :: Typed.TypedTerm Core.Term -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) -> Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Typing.InferenceResult inferenceResult term type_ subst classConstraints context = @@ -532,6 +555,7 @@ Core.Field { Core.fieldName = (Core.Name "context"), Core.fieldTerm = (Typed.unTypedTerm context)}]})) + -- | DSL accessor for the classConstraints field of hydra.typing.InferenceResult inferenceResultClassConstraints :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) inferenceResultClassConstraints x = @@ -540,6 +564,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "classConstraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the context field of hydra.typing.InferenceResult inferenceResultContext :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Typing.InferenceContext inferenceResultContext x = @@ -548,6 +573,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the subst field of hydra.typing.InferenceResult inferenceResultSubst :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Typing.TypeSubst inferenceResultSubst x = @@ -556,6 +582,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "subst")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the term field of hydra.typing.InferenceResult inferenceResultTerm :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Core.Term inferenceResultTerm x = @@ -564,6 +591,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "term")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.typing.InferenceResult inferenceResultType :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Core.Type inferenceResultType x = @@ -572,6 +600,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the classConstraints field of hydra.typing.InferenceResult inferenceResultWithClassConstraints :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm (M.Map Core.Name Core.TypeVariableConstraints) -> Typed.TypedTerm Typing.InferenceResult inferenceResultWithClassConstraints original newVal = @@ -609,6 +638,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the context field of hydra.typing.InferenceResult inferenceResultWithContext :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Typing.InferenceContext -> Typed.TypedTerm Typing.InferenceResult inferenceResultWithContext original newVal = @@ -646,6 +676,7 @@ Core.Field { Core.fieldName = (Core.Name "context"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the subst field of hydra.typing.InferenceResult inferenceResultWithSubst :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm Typing.InferenceResult inferenceResultWithSubst original newVal = @@ -683,6 +714,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the term field of hydra.typing.InferenceResult inferenceResultWithTerm :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Core.Term -> Typed.TypedTerm Typing.InferenceResult inferenceResultWithTerm original newVal = @@ -720,6 +752,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.typing.InferenceResult inferenceResultWithType :: Typed.TypedTerm Typing.InferenceResult -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.InferenceResult inferenceResultWithType original newVal = @@ -757,6 +790,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.InferenceResult"), Core.projectionFieldName = (Core.Name "context")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.typing.Parameter parameter :: Typed.TypedTerm Core.Name -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool -> Typed.TypedTerm Typing.Parameter parameter name description type_ isLazy = @@ -775,6 +809,7 @@ Core.Field { Core.fieldName = (Core.Name "isLazy"), Core.fieldTerm = (Typed.unTypedTerm isLazy)}]})) + -- | DSL accessor for the description field of hydra.typing.Parameter parameterDescription :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm (Maybe String) parameterDescription x = @@ -783,6 +818,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the isLazy field of hydra.typing.Parameter parameterIsLazy :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Bool parameterIsLazy x = @@ -791,6 +827,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "isLazy")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.typing.Parameter parameterName :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Core.Name parameterName x = @@ -799,6 +836,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.typing.Parameter parameterType :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Core.Type parameterType x = @@ -807,6 +845,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the description field of hydra.typing.Parameter parameterWithDescription :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Typing.Parameter parameterWithDescription original newVal = @@ -837,6 +876,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "isLazy")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the isLazy field of hydra.typing.Parameter parameterWithIsLazy :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Bool -> Typed.TypedTerm Typing.Parameter parameterWithIsLazy original newVal = @@ -867,6 +907,7 @@ Core.Field { Core.fieldName = (Core.Name "isLazy"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.typing.Parameter parameterWithName :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Typing.Parameter parameterWithName original newVal = @@ -897,6 +938,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "isLazy")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.typing.Parameter parameterWithType :: Typed.TypedTerm Typing.Parameter -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.Parameter parameterWithType original newVal = @@ -927,6 +969,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Parameter"), Core.projectionFieldName = (Core.Name "isLazy")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.typing.Result result :: Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.Result result description type_ = @@ -939,6 +982,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm type_)}]})) + -- | DSL accessor for the description field of hydra.typing.Result resultDescription :: Typed.TypedTerm Typing.Result -> Typed.TypedTerm (Maybe String) resultDescription x = @@ -947,6 +991,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Result"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the type field of hydra.typing.Result resultType :: Typed.TypedTerm Typing.Result -> Typed.TypedTerm Core.Type resultType x = @@ -955,6 +1000,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Result"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the description field of hydra.typing.Result resultWithDescription :: Typed.TypedTerm Typing.Result -> Typed.TypedTerm (Maybe String) -> Typed.TypedTerm Typing.Result resultWithDescription original newVal = @@ -971,6 +1017,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.Result"), Core.projectionFieldName = (Core.Name "type")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the type field of hydra.typing.Result resultWithType :: Typed.TypedTerm Typing.Result -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.Result resultWithType original newVal = @@ -987,6 +1034,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.typing.TermSignature termSignature :: Typed.TypedTerm [Typing.TypeParameter] -> Typed.TypedTerm [Typing.Parameter] -> Typed.TypedTerm Typing.Result -> Typed.TypedTerm Typing.TermSignature termSignature typeParameters parameters result = @@ -1002,6 +1050,7 @@ Core.Field { Core.fieldName = (Core.Name "result"), Core.fieldTerm = (Typed.unTypedTerm result)}]})) + -- | DSL accessor for the parameters field of hydra.typing.TermSignature termSignatureParameters :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm [Typing.Parameter] termSignatureParameters x = @@ -1010,6 +1059,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TermSignature"), Core.projectionFieldName = (Core.Name "parameters")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the result field of hydra.typing.TermSignature termSignatureResult :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm Typing.Result termSignatureResult x = @@ -1018,6 +1068,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TermSignature"), Core.projectionFieldName = (Core.Name "result")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the typeParameters field of hydra.typing.TermSignature termSignatureTypeParameters :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm [Typing.TypeParameter] termSignatureTypeParameters x = @@ -1026,6 +1077,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TermSignature"), Core.projectionFieldName = (Core.Name "typeParameters")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the parameters field of hydra.typing.TermSignature termSignatureWithParameters :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm [Typing.Parameter] -> Typed.TypedTerm Typing.TermSignature termSignatureWithParameters original newVal = @@ -1049,6 +1101,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TermSignature"), Core.projectionFieldName = (Core.Name "result")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the result field of hydra.typing.TermSignature termSignatureWithResult :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm Typing.Result -> Typed.TypedTerm Typing.TermSignature termSignatureWithResult original newVal = @@ -1072,6 +1125,7 @@ Core.Field { Core.fieldName = (Core.Name "result"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the typeParameters field of hydra.typing.TermSignature termSignatureWithTypeParameters :: Typed.TypedTerm Typing.TermSignature -> Typed.TypedTerm [Typing.TypeParameter] -> Typed.TypedTerm Typing.TermSignature termSignatureWithTypeParameters original newVal = @@ -1095,12 +1149,14 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TermSignature"), Core.projectionFieldName = (Core.Name "result")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.typing.TermSubst wrapper termSubst :: Typed.TypedTerm (M.Map Core.Name Core.Term) -> Typed.TypedTerm Typing.TermSubst termSubst x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.typing.TermSubst"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL constructor for hydra.typing.TypeClass typeClass :: Typed.TypedTerm String -> Typed.TypedTerm Typing.TypeClass typeClass description = @@ -1110,6 +1166,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = (Typed.unTypedTerm description)}]})) + -- | DSL accessor for the description field of hydra.typing.TypeClass typeClassDescription :: Typed.TypedTerm Typing.TypeClass -> Typed.TypedTerm String typeClassDescription x = @@ -1118,6 +1175,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeClass"), Core.projectionFieldName = (Core.Name "description")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1127,6 +1185,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.typing.TypeConstraint typeConstraint :: Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type -> Typed.TypedTerm String -> Typed.TypedTerm Typing.TypeConstraint typeConstraint left right comment = @@ -1142,6 +1201,7 @@ Core.Field { Core.fieldName = (Core.Name "comment"), Core.fieldTerm = (Typed.unTypedTerm comment)}]})) + -- | DSL accessor for the comment field of hydra.typing.TypeConstraint typeConstraintComment :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm String typeConstraintComment x = @@ -1150,6 +1210,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeConstraint"), Core.projectionFieldName = (Core.Name "comment")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the left field of hydra.typing.TypeConstraint typeConstraintLeft :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm Core.Type typeConstraintLeft x = @@ -1158,6 +1219,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeConstraint"), Core.projectionFieldName = (Core.Name "left")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the right field of hydra.typing.TypeConstraint typeConstraintRight :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm Core.Type typeConstraintRight x = @@ -1166,6 +1228,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeConstraint"), Core.projectionFieldName = (Core.Name "right")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1189,6 +1252,7 @@ Core.Field { Core.fieldName = (Core.Name "comment"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the left field of hydra.typing.TypeConstraint typeConstraintWithLeft :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.TypeConstraint typeConstraintWithLeft original newVal = @@ -1212,6 +1276,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeConstraint"), Core.projectionFieldName = (Core.Name "comment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the right field of hydra.typing.TypeConstraint typeConstraintWithRight :: Typed.TypedTerm Typing.TypeConstraint -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Typing.TypeConstraint typeConstraintWithRight original newVal = @@ -1235,6 +1300,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeConstraint"), Core.projectionFieldName = (Core.Name "comment")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.typing.TypeParameter typeParameter :: Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.TypeClassConstraint] -> Typed.TypedTerm Typing.TypeParameter typeParameter name constraints = @@ -1247,6 +1313,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = (Typed.unTypedTerm constraints)}]})) + -- | DSL accessor for the constraints field of hydra.typing.TypeParameter typeParameterConstraints :: Typed.TypedTerm Typing.TypeParameter -> Typed.TypedTerm [Core.TypeClassConstraint] typeParameterConstraints x = @@ -1255,6 +1322,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeParameter"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the name field of hydra.typing.TypeParameter typeParameterName :: Typed.TypedTerm Typing.TypeParameter -> Typed.TypedTerm Core.Name typeParameterName x = @@ -1263,6 +1331,7 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeParameter"), Core.projectionFieldName = (Core.Name "name")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -1279,6 +1348,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the name field of hydra.typing.TypeParameter typeParameterWithName :: Typed.TypedTerm Typing.TypeParameter -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Typing.TypeParameter typeParameterWithName original newVal = @@ -1295,18 +1365,21 @@ Core.projectionTypeName = (Core.Name "hydra.typing.TypeParameter"), Core.projectionFieldName = (Core.Name "constraints")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for the hydra.typing.TypeSubst wrapper typeSubst :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Typing.TypeSubst typeSubst x = Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.typing.TypeSubst"), Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.typing.TermSubst unTermSubst :: Typed.TypedTerm Typing.TermSubst -> Typed.TypedTerm (M.Map Core.Name Core.Term) unTermSubst x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.typing.TermSubst")), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the body of hydra.typing.TypeSubst unTypeSubst :: Typed.TypedTerm Typing.TypeSubst -> Typed.TypedTerm (M.Map Core.Name Core.Type) unTypeSubst x = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.util module Hydra.Dsl.Util where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Packaging as DslPackaging @@ -11,6 +13,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | DSL injection for the camel variant of hydra.util.CaseConvention caseConventionCamel :: Typed.TypedTerm Util.CaseConvention caseConventionCamel = @@ -19,6 +22,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "camel"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lowerSnake variant of hydra.util.CaseConvention caseConventionLowerSnake :: Typed.TypedTerm Util.CaseConvention caseConventionLowerSnake = @@ -27,6 +31,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lowerSnake"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pascal variant of hydra.util.CaseConvention caseConventionPascal :: Typed.TypedTerm Util.CaseConvention caseConventionPascal = @@ -35,6 +40,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pascal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the upperSnake variant of hydra.util.CaseConvention caseConventionUpperSnake :: Typed.TypedTerm Util.CaseConvention caseConventionUpperSnake = @@ -43,6 +49,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "upperSnake"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the equalTo variant of hydra.util.Comparison comparisonEqualTo :: Typed.TypedTerm Util.Comparison comparisonEqualTo = @@ -51,6 +58,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "equalTo"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the greaterThan variant of hydra.util.Comparison comparisonGreaterThan :: Typed.TypedTerm Util.Comparison comparisonGreaterThan = @@ -59,6 +67,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "greaterThan"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lessThan variant of hydra.util.Comparison comparisonLessThan :: Typed.TypedTerm Util.Comparison comparisonLessThan = @@ -67,12 +76,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lessThan"), Core.fieldTerm = Core.TermUnit}})) --- | DSL constructor for the hydra.util.FileExtension wrapper -fileExtension :: Typed.TypedTerm String -> Typed.TypedTerm Util.FileExtension -fileExtension x = - Typed.TypedTerm (Core.TermWrap (Core.WrappedTerm { - Core.wrappedTermTypeName = (Core.Name "hydra.util.FileExtension"), - Core.wrappedTermBody = (Typed.unTypedTerm x)})) + -- | 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 = @@ -85,6 +89,7 @@ Core.Field { Core.fieldName = (Core.Name "mapping"), Core.fieldTerm = (Typed.unTypedTerm mapping)}]})) + -- | DSL accessor for the focus field of hydra.util.ModuleNames moduleNamesFocus :: Typed.TypedTerm (Util.ModuleNames n) -> Typed.TypedTerm (Packaging.ModuleName, n) moduleNamesFocus x = @@ -93,6 +98,7 @@ Core.projectionTypeName = (Core.Name "hydra.util.ModuleNames"), Core.projectionFieldName = (Core.Name "focus")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the mapping field of hydra.util.ModuleNames moduleNamesMapping :: Typed.TypedTerm (Util.ModuleNames n) -> Typed.TypedTerm (M.Map Packaging.ModuleName n) moduleNamesMapping x = @@ -101,6 +107,7 @@ Core.projectionTypeName = (Core.Name "hydra.util.ModuleNames"), Core.projectionFieldName = (Core.Name "mapping")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | 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 = @@ -117,6 +124,7 @@ Core.projectionTypeName = (Core.Name "hydra.util.ModuleNames"), Core.projectionFieldName = (Core.Name "mapping")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the mapping field of hydra.util.ModuleNames moduleNamesWithMapping :: Typed.TypedTerm (Util.ModuleNames n) -> Typed.TypedTerm (M.Map Packaging.ModuleName n) -> Typed.TypedTerm (Util.ModuleNames n) moduleNamesWithMapping original newVal = @@ -133,6 +141,7 @@ Core.Field { Core.fieldName = (Core.Name "mapping"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL injection for the arbitrary variant of hydra.util.Precision precisionArbitrary :: Typed.TypedTerm Util.Precision precisionArbitrary = @@ -141,6 +150,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "arbitrary"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the bits variant of hydra.util.Precision precisionBits :: Typed.TypedTerm Int -> Typed.TypedTerm Util.Precision precisionBits x = @@ -149,6 +159,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "bits"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL constructor for hydra.util.QualifiedName qualifiedName :: Typed.TypedTerm (Maybe Packaging.ModuleName) -> Typed.TypedTerm String -> Typed.TypedTerm Util.QualifiedName qualifiedName moduleName local = @@ -161,6 +172,7 @@ Core.Field { Core.fieldName = (Core.Name "local"), Core.fieldTerm = (Typed.unTypedTerm local)}]})) + -- | DSL accessor for the local field of hydra.util.QualifiedName qualifiedNameLocal :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm String qualifiedNameLocal x = @@ -169,6 +181,7 @@ Core.projectionTypeName = (Core.Name "hydra.util.QualifiedName"), Core.projectionFieldName = (Core.Name "local")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the moduleName field of hydra.util.QualifiedName qualifiedNameModuleName :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm (Maybe Packaging.ModuleName) qualifiedNameModuleName x = @@ -177,6 +190,7 @@ Core.projectionTypeName = (Core.Name "hydra.util.QualifiedName"), Core.projectionFieldName = (Core.Name "moduleName")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the local field of hydra.util.QualifiedName qualifiedNameWithLocal :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm String -> Typed.TypedTerm Util.QualifiedName qualifiedNameWithLocal original newVal = @@ -193,6 +207,7 @@ Core.Field { Core.fieldName = (Core.Name "local"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the moduleName field of hydra.util.QualifiedName qualifiedNameWithModuleName :: Typed.TypedTerm Util.QualifiedName -> Typed.TypedTerm (Maybe Packaging.ModuleName) -> Typed.TypedTerm Util.QualifiedName qualifiedNameWithModuleName original newVal = @@ -209,9 +224,3 @@ Core.projectionTypeName = (Core.Name "hydra.util.QualifiedName"), Core.projectionFieldName = (Core.Name "local")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) --- | DSL accessor for the body of hydra.util.FileExtension -unFileExtension :: Typed.TypedTerm Util.FileExtension -> Typed.TypedTerm String -unFileExtension x = - Typed.TypedTerm (Core.TermApplication (Core.Application { - Core.applicationFunction = (Core.TermUnwrap (Core.Name "hydra.util.FileExtension")), - Core.applicationArgument = (Typed.unTypedTerm x)})) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.validation module Hydra.Dsl.Validation where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Dsl.Error.Core as DslErrorCore @@ -11,6 +13,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | 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 = @@ -29,6 +32,7 @@ Core.Field { Core.fieldName = (Core.Name "maxWarnings"), Core.fieldTerm = (Typed.unTypedTerm maxWarnings)}]})) + -- | DSL accessor for the errorRules field of hydra.validation.ValidationProfile validationProfileErrorRules :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm (S.Set Core.Name) validationProfileErrorRules x = @@ -37,6 +41,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "errorRules")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the maxErrors field of hydra.validation.ValidationProfile validationProfileMaxErrors :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm Int validationProfileMaxErrors x = @@ -45,6 +50,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "maxErrors")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the maxWarnings field of hydra.validation.ValidationProfile validationProfileMaxWarnings :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm Int validationProfileMaxWarnings x = @@ -53,6 +59,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "maxWarnings")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the warningRules field of hydra.validation.ValidationProfile validationProfileWarningRules :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm (S.Set Core.Name) validationProfileWarningRules x = @@ -61,6 +68,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "warningRules")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the errorRules field of hydra.validation.ValidationProfile validationProfileWithErrorRules :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Validation.ValidationProfile validationProfileWithErrorRules original newVal = @@ -91,6 +99,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "maxWarnings")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the maxErrors field of hydra.validation.ValidationProfile validationProfileWithMaxErrors :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm Int -> Typed.TypedTerm Validation.ValidationProfile validationProfileWithMaxErrors original newVal = @@ -121,6 +130,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "maxWarnings")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the maxWarnings field of hydra.validation.ValidationProfile validationProfileWithMaxWarnings :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm Int -> Typed.TypedTerm Validation.ValidationProfile validationProfileWithMaxWarnings original newVal = @@ -151,6 +161,7 @@ Core.Field { Core.fieldName = (Core.Name "maxWarnings"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL updater for the warningRules field of hydra.validation.ValidationProfile validationProfileWithWarningRules :: Typed.TypedTerm Validation.ValidationProfile -> Typed.TypedTerm (S.Set Core.Name) -> Typed.TypedTerm Validation.ValidationProfile validationProfileWithWarningRules original newVal = @@ -181,6 +192,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationProfile"), Core.projectionFieldName = (Core.Name "maxWarnings")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL constructor for hydra.validation.ValidationResult validationResult :: Typed.TypedTerm [e] -> Typed.TypedTerm [e] -> Typed.TypedTerm (Validation.ValidationResult e) validationResult errors warnings = @@ -193,6 +205,7 @@ Core.Field { Core.fieldName = (Core.Name "warnings"), Core.fieldTerm = (Typed.unTypedTerm warnings)}]})) + -- | DSL accessor for the errors field of hydra.validation.ValidationResult validationResultErrors :: Typed.TypedTerm (Validation.ValidationResult e) -> Typed.TypedTerm [e] validationResultErrors x = @@ -201,6 +214,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationResult"), Core.projectionFieldName = (Core.Name "errors")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL accessor for the warnings field of hydra.validation.ValidationResult validationResultWarnings :: Typed.TypedTerm (Validation.ValidationResult e) -> Typed.TypedTerm [e] validationResultWarnings x = @@ -209,6 +223,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationResult"), Core.projectionFieldName = (Core.Name "warnings")})), Core.applicationArgument = (Typed.unTypedTerm x)})) + -- | DSL updater for the errors field of hydra.validation.ValidationResult validationResultWithErrors :: Typed.TypedTerm (Validation.ValidationResult e) -> Typed.TypedTerm [e] -> Typed.TypedTerm (Validation.ValidationResult e) validationResultWithErrors original newVal = @@ -225,6 +240,7 @@ Core.projectionTypeName = (Core.Name "hydra.validation.ValidationResult"), Core.projectionFieldName = (Core.Name "warnings")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) + -- | DSL updater for the warnings field of hydra.validation.ValidationResult validationResultWithWarnings :: Typed.TypedTerm (Validation.ValidationResult e) -> Typed.TypedTerm [e] -> Typed.TypedTerm (Validation.ValidationResult e) validationResultWithWarnings original newVal = 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 @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.variants module Hydra.Dsl.Variants where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Typed as Typed import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | DSL injection for the binary variant of hydra.variants.LiteralVariant literalVariantBinary :: Typed.TypedTerm Variants.LiteralVariant literalVariantBinary = @@ -16,6 +19,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "binary"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the boolean variant of hydra.variants.LiteralVariant literalVariantBoolean :: Typed.TypedTerm Variants.LiteralVariant literalVariantBoolean = @@ -24,6 +28,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "boolean"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the decimal variant of hydra.variants.LiteralVariant literalVariantDecimal :: Typed.TypedTerm Variants.LiteralVariant literalVariantDecimal = @@ -32,6 +37,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decimal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the float variant of hydra.variants.LiteralVariant literalVariantFloat :: Typed.TypedTerm Variants.LiteralVariant literalVariantFloat = @@ -40,6 +46,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the integer variant of hydra.variants.LiteralVariant literalVariantInteger :: Typed.TypedTerm Variants.LiteralVariant literalVariantInteger = @@ -48,6 +55,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "integer"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the string variant of hydra.variants.LiteralVariant literalVariantString :: Typed.TypedTerm Variants.LiteralVariant literalVariantString = @@ -56,6 +64,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the annotated variant of hydra.variants.TermVariant termVariantAnnotated :: Typed.TypedTerm Variants.TermVariant termVariantAnnotated = @@ -64,6 +73,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotated"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the application variant of hydra.variants.TermVariant termVariantApplication :: Typed.TypedTerm Variants.TermVariant termVariantApplication = @@ -72,6 +82,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the cases variant of hydra.variants.TermVariant termVariantCases :: Typed.TypedTerm Variants.TermVariant termVariantCases = @@ -80,6 +91,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the either variant of hydra.variants.TermVariant termVariantEither :: Typed.TypedTerm Variants.TermVariant termVariantEither = @@ -88,6 +100,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "either"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the inject variant of hydra.variants.TermVariant termVariantInject :: Typed.TypedTerm Variants.TermVariant termVariantInject = @@ -96,6 +109,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "inject"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the lambda variant of hydra.variants.TermVariant termVariantLambda :: Typed.TypedTerm Variants.TermVariant termVariantLambda = @@ -104,6 +118,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lambda"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the let variant of hydra.variants.TermVariant termVariantLet :: Typed.TypedTerm Variants.TermVariant termVariantLet = @@ -112,6 +127,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "let"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the list variant of hydra.variants.TermVariant termVariantList :: Typed.TypedTerm Variants.TermVariant termVariantList = @@ -120,6 +136,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "list"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the literal variant of hydra.variants.TermVariant termVariantLiteral :: Typed.TypedTerm Variants.TermVariant termVariantLiteral = @@ -128,6 +145,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "literal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the map variant of hydra.variants.TermVariant termVariantMap :: Typed.TypedTerm Variants.TermVariant termVariantMap = @@ -136,6 +154,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "map"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the optional variant of hydra.variants.TermVariant termVariantOptional :: Typed.TypedTerm Variants.TermVariant termVariantOptional = @@ -144,6 +163,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optional"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pair variant of hydra.variants.TermVariant termVariantPair :: Typed.TypedTerm Variants.TermVariant termVariantPair = @@ -152,6 +172,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pair"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the project variant of hydra.variants.TermVariant termVariantProject :: Typed.TypedTerm Variants.TermVariant termVariantProject = @@ -160,6 +181,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "project"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the record variant of hydra.variants.TermVariant termVariantRecord :: Typed.TypedTerm Variants.TermVariant termVariantRecord = @@ -168,6 +190,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "record"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the set variant of hydra.variants.TermVariant termVariantSet :: Typed.TypedTerm Variants.TermVariant termVariantSet = @@ -176,6 +199,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the typeApplication variant of hydra.variants.TermVariant termVariantTypeApplication :: Typed.TypedTerm Variants.TermVariant termVariantTypeApplication = @@ -184,6 +208,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeApplication"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the typeLambda variant of hydra.variants.TermVariant termVariantTypeLambda :: Typed.TypedTerm Variants.TermVariant termVariantTypeLambda = @@ -192,6 +217,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeLambda"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unit variant of hydra.variants.TermVariant termVariantUnit :: Typed.TypedTerm Variants.TermVariant termVariantUnit = @@ -200,6 +226,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unit"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unwrap variant of hydra.variants.TermVariant termVariantUnwrap :: Typed.TypedTerm Variants.TermVariant termVariantUnwrap = @@ -208,6 +235,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unwrap"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the variable variant of hydra.variants.TermVariant termVariantVariable :: Typed.TypedTerm Variants.TermVariant termVariantVariable = @@ -216,6 +244,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the wrap variant of hydra.variants.TermVariant termVariantWrap :: Typed.TypedTerm Variants.TermVariant termVariantWrap = @@ -224,6 +253,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the annotated variant of hydra.variants.TypeVariant typeVariantAnnotated :: Typed.TypedTerm Variants.TypeVariant typeVariantAnnotated = @@ -232,6 +262,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "annotated"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the application variant of hydra.variants.TypeVariant typeVariantApplication :: Typed.TypedTerm Variants.TypeVariant typeVariantApplication = @@ -240,6 +271,16 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), Core.fieldTerm = Core.TermUnit}})) + +-- | DSL injection for the effect variant of hydra.variants.TypeVariant +typeVariantEffect :: Typed.TypedTerm Variants.TypeVariant +typeVariantEffect = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.variants.TypeVariant"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "effect"), + Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the either variant of hydra.variants.TypeVariant typeVariantEither :: Typed.TypedTerm Variants.TypeVariant typeVariantEither = @@ -248,6 +289,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "either"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the forall variant of hydra.variants.TypeVariant typeVariantForall :: Typed.TypedTerm Variants.TypeVariant typeVariantForall = @@ -256,6 +298,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "forall"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the function variant of hydra.variants.TypeVariant typeVariantFunction :: Typed.TypedTerm Variants.TypeVariant typeVariantFunction = @@ -264,6 +307,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "function"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the list variant of hydra.variants.TypeVariant typeVariantList :: Typed.TypedTerm Variants.TypeVariant typeVariantList = @@ -272,6 +316,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "list"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the literal variant of hydra.variants.TypeVariant typeVariantLiteral :: Typed.TypedTerm Variants.TypeVariant typeVariantLiteral = @@ -280,6 +325,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "literal"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the map variant of hydra.variants.TypeVariant typeVariantMap :: Typed.TypedTerm Variants.TypeVariant typeVariantMap = @@ -288,6 +334,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "map"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the optional variant of hydra.variants.TypeVariant typeVariantOptional :: Typed.TypedTerm Variants.TypeVariant typeVariantOptional = @@ -296,6 +343,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optional"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the pair variant of hydra.variants.TypeVariant typeVariantPair :: Typed.TypedTerm Variants.TypeVariant typeVariantPair = @@ -304,6 +352,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "pair"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the record variant of hydra.variants.TypeVariant typeVariantRecord :: Typed.TypedTerm Variants.TypeVariant typeVariantRecord = @@ -312,6 +361,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "record"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the set variant of hydra.variants.TypeVariant typeVariantSet :: Typed.TypedTerm Variants.TypeVariant typeVariantSet = @@ -320,6 +370,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the union variant of hydra.variants.TypeVariant typeVariantUnion :: Typed.TypedTerm Variants.TypeVariant typeVariantUnion = @@ -328,6 +379,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "union"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the unit variant of hydra.variants.TypeVariant typeVariantUnit :: Typed.TypedTerm Variants.TypeVariant typeVariantUnit = @@ -336,6 +388,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unit"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the variable variant of hydra.variants.TypeVariant typeVariantVariable :: Typed.TypedTerm Variants.TypeVariant typeVariantVariable = @@ -344,6 +397,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the void variant of hydra.variants.TypeVariant typeVariantVoid :: Typed.TypedTerm Variants.TypeVariant typeVariantVoid = @@ -352,6 +406,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "void"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the wrap variant of hydra.variants.TypeVariant typeVariantWrap :: Typed.TypedTerm Variants.TypeVariant typeVariantWrap = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | DSL functions for hydra.yaml.model module Hydra.Dsl.Yaml.Model where + import qualified Hydra.Core as Core import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Typed as Typed @@ -9,6 +11,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | DSL injection for the mapping variant of hydra.yaml.model.Node nodeMapping :: Typed.TypedTerm (M.Map Model.Node Model.Node) -> Typed.TypedTerm Model.Node nodeMapping x = @@ -17,6 +20,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "mapping"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the scalar variant of hydra.yaml.model.Node nodeScalar :: Typed.TypedTerm Model.Scalar -> Typed.TypedTerm Model.Node nodeScalar x = @@ -25,6 +29,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "scalar"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the sequence variant of hydra.yaml.model.Node nodeSequence :: Typed.TypedTerm [Model.Node] -> Typed.TypedTerm Model.Node nodeSequence x = @@ -33,6 +38,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "sequence"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the bool variant of hydra.yaml.model.Scalar scalarBool :: Typed.TypedTerm Bool -> Typed.TypedTerm Model.Scalar scalarBool x = @@ -41,6 +47,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "bool"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the decimal variant of hydra.yaml.model.Scalar scalarDecimal :: Typed.TypedTerm Sci.Scientific -> Typed.TypedTerm Model.Scalar scalarDecimal x = @@ -49,6 +56,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decimal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the float variant of hydra.yaml.model.Scalar scalarFloat :: Typed.TypedTerm Double -> Typed.TypedTerm Model.Scalar scalarFloat x = @@ -57,6 +65,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the int variant of hydra.yaml.model.Scalar scalarInt :: Typed.TypedTerm Integer -> Typed.TypedTerm Model.Scalar scalarInt x = @@ -65,6 +74,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "int"), Core.fieldTerm = (Typed.unTypedTerm x)}})) + -- | DSL injection for the null variant of hydra.yaml.model.Scalar scalarNull :: Typed.TypedTerm Model.Scalar scalarNull = @@ -73,6 +83,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "null"), Core.fieldTerm = Core.TermUnit}})) + -- | DSL injection for the str variant of hydra.yaml.model.Scalar scalarStr :: Typed.TypedTerm String -> Typed.TypedTerm Model.Scalar scalarStr x = 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 @@ -1,31 +1,37 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for generating domain-specific DSL modules from type modules module Hydra.Dsls 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.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -34,8 +40,10 @@ 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 @@ -44,6 +52,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Collect forall type variable names from a type collectForallVars :: Core.Type -> [Core.Name] collectForallVars typ = @@ -51,6 +60,7 @@ Core.TypeAnnotated v0 -> collectForallVars (Core.annotatedTypeBody v0) Core.TypeForall v0 -> Lists.cons (Core.forallTypeParameter v0) (collectForallVars (Core.forallTypeBody v0)) _ -> [] + -- | Deduplicate bindings by appending numeric suffixes to duplicate names deduplicateBindings :: [Core.Binding] -> [Core.Binding] deduplicateBindings bindings = @@ -62,6 +72,7 @@ Core.bindingName = uniqueName, Core.bindingTerm = (Core.bindingTerm b), Core.bindingTypeScheme = (Core.bindingTypeScheme b)}])) [] bindings + -- | Generate a binding name for a DSL function from a type name dslBindingName :: Core.Name -> Core.Name dslBindingName n = @@ -78,6 +89,7 @@ "dsl"] nsParts) in (Core.Name (Strings.intercalate "." (Lists.concat2 dslNsParts [ localPart])))))) + -- | Generate a qualified DSL element name from a type name and local element name dslDefinitionName :: Core.Name -> String -> Core.Name dslDefinitionName typeName localName = @@ -94,7 +106,8 @@ "dsl"] nsParts)) in (Core.Name (Strings.intercalate "." (Lists.concat2 dslNsParts [ localName]))))) --- | Transform a type module into a DSL module + +-- | 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 @@ -112,25 +125,28 @@ 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 mod)))) (\typeBindings -> Logic.ifElse (Lists.null typeBindings) (Right Nothing) (Eithers.bind (Eithers.mapList (\b -> Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\x -> x) (generateBindingsForType cx graph b)) typeBindings) (\dslBindings -> Right (Just (Packaging.Module { - Packaging.moduleName = (dslModuleName (Packaging.moduleName mod)), - Packaging.moduleMetadata = (Just (Packaging.EntityMetadata { - Packaging.entityMetadataDescription = (Just (Strings.cat [ - "DSL functions for ", - (Packaging.unModuleName (Packaging.moduleName mod))])), - Packaging.entityMetadataComments = [], - Packaging.entityMetadataSeeAlso = [], - Packaging.entityMetadataLifecycle = Nothing})), - Packaging.moduleDependencies = (Lists.map (\ns -> Packaging.ModuleDependency { - Packaging.moduleDependencyModule = ns, - Packaging.moduleDependencyPackage = Nothing}) (Lists.nub (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.moduleDefinitions = (Lists.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { - Packaging.termDefinitionName = (Core.bindingName b), - Packaging.termDefinitionMetadata = Nothing, - Packaging.termDefinitionSignature = (Optionals.map Scoping.typeSchemeToTermSignature (Core.bindingTypeScheme b)), - Packaging.termDefinitionBody = (Core.bindingTerm b)})) (deduplicateBindings (Lists.concat dslBindings)))}))))) + _ -> Nothing) (Packaging.moduleDefinitions mod)))) (\typeBindings -> Eithers.bind (Eithers.mapList (\b -> Eithers.bimap (\_e -> Errors.ErrorDecoding _e) (\x -> x) (generateBindingsForType cx graph b)) typeBindings) (\typeDslBindings -> Eithers.bind (Eithers.mapList (\d -> generateRefBindings d) (Packaging.moduleDefinitions mod)) (\refDslBindings -> + let allBindings = deduplicateBindings (Lists.concat2 (Lists.concat typeDslBindings) (Lists.concat refDslBindings)) + 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 [ + "DSL functions for ", + (Packaging.unModuleName (Packaging.moduleName mod))])), + Packaging.entityMetadataComments = [], + Packaging.entityMetadataSeeAlso = [], + Packaging.entityMetadataLifecycle = Nothing})), + Packaging.moduleDependencies = (Lists.map (\ns -> Packaging.ModuleDependency { + Packaging.moduleDependencyModule = ns, + Packaging.moduleDependencyPackage = Nothing}) (Lists.nub (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.moduleDefinitions = (Lists.map (\b -> Packaging.DefinitionTerm (Packaging.TermDefinition { + Packaging.termDefinitionName = (Core.bindingName b), + Packaging.termDefinitionMetadata = Nothing, + Packaging.termDefinitionSignature = (Optionals.map Scoping.typeSchemeToTermSignature (Core.bindingTypeScheme b)), + Packaging.termDefinitionBody = (Core.bindingTerm b)})) allBindings)}))))))) + -- | Generate a DSL module name from a source module name dslModuleName :: Packaging.ModuleName -> Packaging.ModuleName dslModuleName ns = @@ -143,6 +159,29 @@ 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)) + +-- | Build a TypedTerm-wrapped TypeScheme (functions of phantom terms) from a TermSignature +dslSignatureTypeScheme :: Typing.TermSignature -> Core.TypeScheme +dslSignatureTypeScheme sig = + + let typeVars = Lists.map (\tp -> Typing.typeParameterName tp) (Typing.termSignatureTypeParameters sig) + paramTypes = Lists.map (\p -> Typing.parameterType p) (Typing.termSignatureParameters sig) + resultType = Typing.resultType (Typing.termSignatureResult sig) + wrappedResult = + Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedTerm")), + Core.applicationTypeArgument = resultType}) + funType = + Lists.foldr (\paramType -> \acc -> Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedTerm")), + Core.applicationTypeArgument = paramType})), + Core.functionTypeCodomain = acc})) wrappedResult paramTypes + in Core.TypeScheme { + Core.typeSchemeVariables = typeVars, + Core.typeSchemeBody = funType, + Core.typeSchemeConstraints = Nothing} + -- | Build a TypeScheme with TypedTerm-wrapped parameter and result types dslTypeScheme :: Core.Type -> [Core.Type] -> Core.Type -> Core.TypeScheme dslTypeScheme origType paramTypes resultType = @@ -162,10 +201,12 @@ Core.typeSchemeVariables = typeVars, Core.typeSchemeBody = funType, Core.typeSchemeConstraints = Nothing} + -- | 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)) + -- | Generate all DSL bindings for a type binding generateBindingsForType :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.DecodingError [Core.Binding] generateBindingsForType cx graph b = @@ -181,6 +222,7 @@ Core.TypeUnion v0 -> Lists.map (generateUnionInjector rawType typeName) v0 Core.TypeWrap v0 -> generateWrappedTypeAccessors rawType typeName v0 _ -> [])))) + -- | Generate a record field accessor function generateRecordAccessor :: Core.Type -> Core.Name -> Core.FieldType -> Core.Binding generateRecordAccessor origType typeName ft = @@ -245,6 +287,7 @@ Core.bindingName = accessorName, Core.bindingTerm = body, Core.bindingTypeScheme = (Just ts)} + -- | Generate a record constructor function generateRecordConstructor :: Core.Type -> Core.Name -> [Core.FieldType] -> [Core.Binding] generateRecordConstructor origType typeName fieldTypes = @@ -305,6 +348,7 @@ Core.bindingName = (dslBindingName typeName), Core.bindingTerm = body, Core.bindingTypeScheme = (Just ts)}] + -- | Generate a withXxx record field updater function generateRecordWithUpdater :: Core.Type -> Core.Name -> [Core.FieldType] -> Core.FieldType -> Core.Binding generateRecordWithUpdater origType typeName allFields targetField = @@ -408,6 +452,71 @@ Core.bindingName = updaterName, Core.bindingTerm = body, Core.bindingTypeScheme = (Just ts)} + +-- | Generate typed reference DSL bindings for a primitive (or signature-carrying term) definition +generateRefBindings :: Packaging.Definition -> Either t0 [Core.Binding] +generateRefBindings d = + case d of + Packaging.DefinitionType _ -> Right [] + Packaging.DefinitionTerm v0 -> Optionals.cases (Packaging.termDefinitionSignature v0) (Right []) (\sig -> Right [ + generateSignatureRef (Packaging.termDefinitionName v0) sig]) + Packaging.DefinitionPrimitive v0 -> Right [ + generateSignatureRef (Packaging.primitiveDefinitionName v0) (Packaging.primitiveDefinitionSignature v0)] + _ -> Right [] + +-- | Generate a typed-reference DSL wrapper from a term/primitive name and signature +generateSignatureRef :: Core.Name -> Typing.TermSignature -> Core.Binding +generateSignatureRef refName sig = + + let params = Typing.termSignatureParameters sig + paramPairs = + Lists.map (\p -> ( + Core.unName (Typing.parameterName p), + (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.typed.TypedTerm")), + Core.applicationTypeArgument = (Typing.parameterType p)})))) params + 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 + refTerm = + 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})) refTerm (Lists.reverse paramPairs) + description = + Strings.cat [ + "DSL reference to ", + (Core.unName refName)] + body = Annotations.setTermDescription (Just description) rawBody + ts = dslSignatureTypeScheme sig + in Core.Binding { + Core.bindingName = (dslDefinitionName refName (Names.localNameOf refName)), + 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 = @@ -482,6 +591,7 @@ Core.bindingName = injectorName, Core.bindingTerm = body, Core.bindingTypeScheme = (Just ts)} + -- | Generate wrap/unwrap accessors for a wrapped type generateWrappedTypeAccessors :: Core.Type -> Core.Name -> Core.Type -> [Core.Binding] generateWrappedTypeAccessors origType typeName innerType = @@ -576,12 +686,14 @@ Core.bindingName = unwrapName, Core.bindingTerm = unwrapBody, Core.bindingTypeScheme = (Just unwrapTs)}] + -- | Check if a binding is eligible for DSL generation isDslEligibleBinding :: t0 -> t1 -> Core.Binding -> Either t2 (Maybe Core.Binding) isDslEligibleBinding cx graph b = let ns = Names.moduleNameOf (Core.bindingName b) in (Logic.ifElse (Equality.equal (Optionals.cases ns "" Packaging.unModuleName) "hydra.typed") (Right Nothing) (Right (Just b))) + -- | Build the nominal result type with type applications for forall variables nominalResultType :: Core.Name -> Core.Type -> Core.Type nominalResultType typeName origType = diff --git a/src/main/haskell/Hydra/Encode/Ast.hs b/src/main/haskell/Hydra/Encode/Ast.hs --- a/src/main/haskell/Hydra/Encode/Ast.hs +++ b/src/main/haskell/Hydra/Encode/Ast.hs @@ -1,14 +1,17 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.ast module Hydra.Encode.Ast where + import qualified Hydra.Ast as Ast import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.ast.Associativity associativity :: Ast.Associativity -> Core.Term associativity x = @@ -33,6 +36,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "both"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.ast.BlockStyle blockStyle :: Ast.BlockStyle -> Core.Term blockStyle x = @@ -48,6 +52,7 @@ Core.Field { Core.fieldName = (Core.Name "newlineAfterContent"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBoolean x2)) (Ast.blockStyleNewlineAfterContent x))}]}) + -- | Encoder for hydra.ast.BracketExpr bracketExpr :: Ast.BracketExpr -> Core.Term bracketExpr x = @@ -63,6 +68,7 @@ Core.Field { Core.fieldName = (Core.Name "style"), Core.fieldTerm = (blockStyle (Ast.bracketExprStyle x))}]}) + -- | Encoder for hydra.ast.Brackets brackets :: Ast.Brackets -> Core.Term brackets x = @@ -75,6 +81,7 @@ Core.Field { Core.fieldName = (Core.Name "close"), Core.fieldTerm = (symbol (Ast.bracketsClose x))}]}) + -- | Encoder for hydra.ast.Expr expr :: Ast.Expr -> Core.Term expr x = @@ -104,6 +111,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "seq"), Core.fieldTerm = (seqExpr v0)}}) + -- | Encoder for hydra.ast.IndentStyle indentStyle :: Ast.IndentStyle -> Core.Term indentStyle x = @@ -118,6 +126,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "subsequentLines"), Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + -- | Encoder for hydra.ast.IndentedExpression indentedExpression :: Ast.IndentedExpression -> Core.Term indentedExpression x = @@ -130,6 +139,7 @@ Core.Field { Core.fieldName = (Core.Name "expr"), Core.fieldTerm = (expr (Ast.indentedExpressionExpr x))}]}) + -- | Encoder for hydra.ast.Op op :: Ast.Op -> Core.Term op x = @@ -148,6 +158,7 @@ Core.Field { Core.fieldName = (Core.Name "associativity"), Core.fieldTerm = (associativity (Ast.opAssociativity x))}]}) + -- | Encoder for hydra.ast.OpExpr opExpr :: Ast.OpExpr -> Core.Term opExpr x = @@ -163,6 +174,7 @@ Core.Field { Core.fieldName = (Core.Name "rhs"), Core.fieldTerm = (expr (Ast.opExprRhs x))}]}) + -- | Encoder for hydra.ast.Padding padding :: Ast.Padding -> Core.Term padding x = @@ -175,12 +187,14 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (ws (Ast.paddingRight x))}]}) + -- | Encoder for hydra.ast.Precedence precedence :: Ast.Precedence -> Core.Term precedence x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.ast.Precedence"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Ast.unPrecedence x))}) + -- | Encoder for hydra.ast.SeqExpr seqExpr :: Ast.SeqExpr -> Core.Term seqExpr x = @@ -193,12 +207,14 @@ Core.Field { Core.fieldName = (Core.Name "elements"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map expr xs)) (Ast.seqExprElements x))}]}) + -- | Encoder for hydra.ast.Symbol symbol :: Ast.Symbol -> Core.Term symbol x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.ast.Symbol"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Ast.unSymbol x))}) + -- | Encoder for hydra.ast.Ws ws :: Ast.Ws -> Core.Term ws x = diff --git a/src/main/haskell/Hydra/Encode/Coders.hs b/src/main/haskell/Hydra/Encode/Coders.hs --- a/src/main/haskell/Hydra/Encode/Coders.hs +++ b/src/main/haskell/Hydra/Encode/Coders.hs @@ -1,16 +1,19 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.coders module Hydra.Encode.Coders where + import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Errors as Errors -import qualified Hydra.Encode.Typing as Typing +import qualified Hydra.Encode.File as File import qualified Hydra.Encode.Util as Util import qualified Hydra.Encode.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.coders.CaseConventions caseConventions :: Coders.CaseConventions -> Core.Term caseConventions x = @@ -47,6 +50,7 @@ Core.Field { Core.fieldName = (Core.Name "typeVariable"), Core.fieldTerm = (Util.caseConvention (Coders.caseConventionsTypeVariable x))}]}) + -- | Encoder for hydra.coders.CoderDirection coderDirection :: Coders.CoderDirection -> Core.Term coderDirection x = @@ -61,6 +65,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "decode"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.coders.LanguageFeature languageFeature :: Coders.LanguageFeature -> Core.Term languageFeature x = @@ -80,12 +85,14 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedPolymorphicLetBindings"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.coders.LanguageName languageName :: Coders.LanguageName -> Core.Term languageName x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.coders.LanguageName"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Coders.unLanguageName x))}) + -- | Encoder for hydra.coders.TraversalOrder traversalOrder :: Coders.TraversalOrder -> Core.Term traversalOrder x = diff --git a/src/main/haskell/Hydra/Encode/Core.hs b/src/main/haskell/Hydra/Encode/Core.hs --- a/src/main/haskell/Hydra/Encode/Core.hs +++ b/src/main/haskell/Hydra/Encode/Core.hs @@ -1,16 +1,19 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.core module Hydra.Encode.Core where + import qualified Hydra.Core as Core -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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 Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.core.AnnotatedTerm annotatedTerm :: Core.AnnotatedTerm -> Core.Term annotatedTerm x = @@ -23,6 +26,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (term (Core.annotatedTermAnnotation x))}]}) + -- | Encoder for hydra.core.AnnotatedType annotatedType :: Core.AnnotatedType -> Core.Term annotatedType x = @@ -35,6 +39,7 @@ Core.Field { Core.fieldName = (Core.Name "annotation"), Core.fieldTerm = (term (Core.annotatedTypeAnnotation x))}]}) + -- | Encoder for hydra.core.Application application :: Core.Application -> Core.Term application x = @@ -47,6 +52,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (term (Core.applicationArgument x))}]}) + -- | Encoder for hydra.core.ApplicationType applicationType :: Core.ApplicationType -> Core.Term applicationType x = @@ -59,6 +65,7 @@ Core.Field { Core.fieldName = (Core.Name "argument"), Core.fieldTerm = (type_ (Core.applicationTypeArgument x))}]}) + -- | Encoder for hydra.core.Binding binding :: Core.Binding -> Core.Term binding x = @@ -74,6 +81,7 @@ Core.Field { Core.fieldName = (Core.Name "typeScheme"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map typeScheme opt)) (Core.bindingTypeScheme x))}]}) + -- | Encoder for hydra.core.CaseAlternative caseAlternative :: Core.CaseAlternative -> Core.Term caseAlternative x = @@ -86,6 +94,7 @@ Core.Field { Core.fieldName = (Core.Name "handler"), Core.fieldTerm = (term (Core.caseAlternativeHandler x))}]}) + -- | Encoder for hydra.core.CaseStatement caseStatement :: Core.CaseStatement -> Core.Term caseStatement x = @@ -101,6 +110,7 @@ Core.Field { Core.fieldName = (Core.Name "cases"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map caseAlternative xs)) (Core.caseStatementCases x))}]}) + -- | Encoder for hydra.core.EitherType eitherType :: Core.EitherType -> Core.Term eitherType x = @@ -113,6 +123,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (type_ (Core.eitherTypeRight x))}]}) + -- | Encoder for hydra.core.Field field :: Core.Field -> Core.Term field x = @@ -125,6 +136,7 @@ Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (term (Core.fieldTerm x))}]}) + -- | Encoder for hydra.core.FieldType fieldType :: Core.FieldType -> Core.Term fieldType x = @@ -137,6 +149,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (type_ (Core.fieldTypeType x))}]}) + -- | Encoder for hydra.core.FloatType floatType :: Core.FloatType -> Core.Term floatType x = @@ -151,6 +164,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float64"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.core.FloatValue floatValue :: Core.FloatValue -> Core.Term floatValue x = @@ -165,6 +179,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "float64"), Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v0)))}}) + -- | Encoder for hydra.core.ForallType forallType :: Core.ForallType -> Core.Term forallType x = @@ -177,6 +192,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (type_ (Core.forallTypeBody x))}]}) + -- | Encoder for hydra.core.FunctionType functionType :: Core.FunctionType -> Core.Term functionType x = @@ -189,6 +205,7 @@ Core.Field { Core.fieldName = (Core.Name "codomain"), Core.fieldTerm = (type_ (Core.functionTypeCodomain x))}]}) + -- | Encoder for hydra.core.Injection injection :: Core.Injection -> Core.Term injection x = @@ -201,6 +218,7 @@ Core.Field { Core.fieldName = (Core.Name "field"), Core.fieldTerm = (field (Core.injectionField x))}]}) + -- | Encoder for hydra.core.IntegerType integerType :: Core.IntegerType -> Core.Term integerType x = @@ -250,6 +268,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint64"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.core.IntegerValue integerValue :: Core.IntegerValue -> Core.Term integerValue x = @@ -299,6 +318,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "uint64"), Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 v0)))}}) + -- | Encoder for hydra.core.Lambda lambda :: Core.Lambda -> Core.Term lambda x = @@ -314,6 +334,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (term (Core.lambdaBody x))}]}) + -- | Encoder for hydra.core.Let let_ :: Core.Let -> Core.Term let_ x = @@ -326,6 +347,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (term (Core.letBody x))}]}) + -- | Encoder for hydra.core.Literal literal :: Core.Literal -> Core.Term literal x = @@ -360,6 +382,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + -- | Encoder for hydra.core.LiteralType literalType :: Core.LiteralType -> Core.Term literalType x = @@ -394,6 +417,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.core.MapType mapType :: Core.MapType -> Core.Term mapType x = @@ -406,12 +430,14 @@ Core.Field { Core.fieldName = (Core.Name "values"), Core.fieldTerm = (type_ (Core.mapTypeValues x))}]}) + -- | Encoder for hydra.core.Name name :: Core.Name -> Core.Term name x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Core.unName x))}) + -- | Encoder for hydra.core.PairType pairType :: Core.PairType -> Core.Term pairType x = @@ -424,6 +450,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (type_ (Core.pairTypeSecond x))}]}) + -- | Encoder for hydra.core.Projection projection :: Core.Projection -> Core.Term projection x = @@ -436,6 +463,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (name (Core.projectionFieldName x))}]}) + -- | Encoder for hydra.core.Record record :: Core.Record -> Core.Term record x = @@ -448,6 +476,7 @@ Core.Field { Core.fieldName = (Core.Name "fields"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map field xs)) (Core.recordFields x))}]}) + -- | Encoder for hydra.core.Term term :: Core.Term -> Core.Term term x = @@ -557,6 +586,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = (wrappedTerm v0)}}) + -- | Encoder for hydra.core.Type type_ :: Core.Type -> Core.Term type_ x = @@ -571,6 +601,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), Core.fieldTerm = (applicationType v0)}}) + Core.TypeEffect v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.core.Type"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "effect"), + Core.fieldTerm = (type_ v0)}}) Core.TypeEither v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.core.Type"), Core.injectionField = Core.Field { @@ -646,6 +681,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = (type_ v0)}}) + -- | Encoder for hydra.core.TypeApplicationTerm typeApplicationTerm :: Core.TypeApplicationTerm -> Core.Term typeApplicationTerm x = @@ -658,6 +694,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (type_ (Core.typeApplicationTermType x))}]}) + -- | Encoder for hydra.core.TypeClassConstraint typeClassConstraint :: Core.TypeClassConstraint -> Core.Term typeClassConstraint x = @@ -667,6 +704,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "simple"), Core.fieldTerm = (name v0)}}) + -- | Encoder for hydra.core.TypeLambda typeLambda :: Core.TypeLambda -> Core.Term typeLambda x = @@ -679,6 +717,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (term (Core.typeLambdaBody x))}]}) + -- | Encoder for hydra.core.TypeScheme typeScheme :: Core.TypeScheme -> Core.Term typeScheme x = @@ -694,6 +733,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map (\m -> Core.TermMap (Maps.bimap name typeVariableConstraints m)) opt)) (Core.typeSchemeConstraints x))}]}) + -- | Encoder for hydra.core.TypeVariableConstraints typeVariableConstraints :: Core.TypeVariableConstraints -> Core.Term typeVariableConstraints x = @@ -703,6 +743,7 @@ Core.Field { Core.fieldName = (Core.Name "classes"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map typeClassConstraint xs)) (Core.typeVariableConstraintsClasses x))}]}) + -- | Encoder for hydra.core.WrappedTerm wrappedTerm :: Core.WrappedTerm -> Core.Term wrappedTerm x = diff --git a/src/main/haskell/Hydra/Encode/Docs.hs b/src/main/haskell/Hydra/Encode/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/Docs.hs @@ -0,0 +1,26 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.docs + +module Hydra.Encode.Docs where + +import qualified Hydra.Core as Core +import qualified Hydra.Docs as Docs +import qualified Hydra.Encode.Packaging as Packaging +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.docs.DocSegment +docSegment :: Docs.DocSegment -> Core.Term +docSegment x = + case x of + Docs.DocSegmentRef v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.docs.DocSegment"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "ref"), + Core.fieldTerm = (Packaging.entityReference v0)}}) + Docs.DocSegmentText v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.docs.DocSegment"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "text"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) diff --git a/src/main/haskell/Hydra/Encode/Error/Checking.hs b/src/main/haskell/Hydra/Encode/Error/Checking.hs --- a/src/main/haskell/Hydra/Encode/Error/Checking.hs +++ b/src/main/haskell/Hydra/Encode/Error/Checking.hs @@ -1,17 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.error.checking module Hydra.Encode.Error.Checking where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Paths as Paths import qualified Hydra.Encode.Typing as Typing import qualified Hydra.Encode.Variants as Variants import qualified Hydra.Error.Checking as Checking -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.error.checking.CheckingError checkingError :: Checking.CheckingError -> Core.Term checkingError x = @@ -81,6 +84,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedTermVariable"), Core.fieldTerm = (untypedTermVariableCheckingError v0)}}) + -- | Encoder for hydra.error.checking.IncorrectUnificationError incorrectUnificationError :: Checking.IncorrectUnificationError -> Core.Term incorrectUnificationError x = @@ -90,6 +94,7 @@ Core.Field { Core.fieldName = (Core.Name "substitution"), Core.fieldTerm = (Typing.typeSubst (Checking.incorrectUnificationErrorSubstitution x))}]}) + -- | Encoder for hydra.error.checking.NotAForallTypeError notAForallTypeError :: Checking.NotAForallTypeError -> Core.Term notAForallTypeError x = @@ -102,6 +107,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.type_ xs)) (Checking.notAForallTypeErrorTypeArguments x))}]}) + -- | Encoder for hydra.error.checking.NotAFunctionTypeError notAFunctionTypeError :: Checking.NotAFunctionTypeError -> Core.Term notAFunctionTypeError x = @@ -111,6 +117,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (EncodeCore.type_ (Checking.notAFunctionTypeErrorType x))}]}) + -- | Encoder for hydra.error.checking.OtherCheckingError otherCheckingError :: Checking.OtherCheckingError -> Core.Term otherCheckingError x = @@ -123,6 +130,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Checking.otherCheckingErrorMessage x))}]}) + -- | Encoder for hydra.error.checking.TypeArityMismatchError typeArityMismatchError :: Checking.TypeArityMismatchError -> Core.Term typeArityMismatchError x = @@ -141,6 +149,7 @@ Core.Field { Core.fieldName = (Core.Name "typeArguments"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.type_ xs)) (Checking.typeArityMismatchErrorTypeArguments x))}]}) + -- | Encoder for hydra.error.checking.TypeMismatchError typeMismatchError :: Checking.TypeMismatchError -> Core.Term typeMismatchError x = @@ -153,6 +162,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (EncodeCore.type_ (Checking.typeMismatchErrorActualType x))}]}) + -- | Encoder for hydra.error.checking.UnboundTypeVariablesError unboundTypeVariablesError :: Checking.UnboundTypeVariablesError -> Core.Term unboundTypeVariablesError x = @@ -165,6 +175,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (EncodeCore.type_ (Checking.unboundTypeVariablesErrorType x))}]}) + -- | Encoder for hydra.error.checking.UndefinedTermVariableCheckingError undefinedTermVariableCheckingError :: Checking.UndefinedTermVariableCheckingError -> Core.Term undefinedTermVariableCheckingError x = @@ -177,6 +188,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (Checking.undefinedTermVariableCheckingErrorName x))}]}) + -- | Encoder for hydra.error.checking.UnequalTypesError unequalTypesError :: Checking.UnequalTypesError -> Core.Term unequalTypesError x = @@ -189,6 +201,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Checking.unequalTypesErrorDescription x))}]}) + -- | Encoder for hydra.error.checking.UnsupportedTermVariantError unsupportedTermVariantError :: Checking.UnsupportedTermVariantError -> Core.Term unsupportedTermVariantError x = @@ -198,12 +211,14 @@ Core.Field { Core.fieldName = (Core.Name "termVariant"), Core.fieldTerm = (Variants.termVariant (Checking.unsupportedTermVariantErrorTermVariant x))}]}) + -- | Encoder for hydra.error.checking.UntypedLambdaError untypedLambdaError :: Checking.UntypedLambdaError -> Core.Term untypedLambdaError x = Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra.error.checking.UntypedLambdaError"), Core.recordFields = []}) + -- | Encoder for hydra.error.checking.UntypedLetBindingError untypedLetBindingError :: Checking.UntypedLetBindingError -> Core.Term untypedLetBindingError x = @@ -213,6 +228,7 @@ Core.Field { Core.fieldName = (Core.Name "binding"), Core.fieldTerm = (EncodeCore.binding (Checking.untypedLetBindingErrorBinding x))}]}) + -- | Encoder for hydra.error.checking.UntypedTermVariableCheckingError untypedTermVariableCheckingError :: Checking.UntypedTermVariableCheckingError -> Core.Term untypedTermVariableCheckingError x = 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.error.core module Hydra.Encode.Error.Core where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Paths as Paths @@ -9,6 +11,7 @@ import qualified Hydra.Error.Core as ErrorCore import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.error.core.ConstantConditionError constantConditionError :: ErrorCore.ConstantConditionError -> Core.Term constantConditionError x = @@ -21,6 +24,7 @@ Core.Field { Core.fieldName = (Core.Name "value"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBoolean x2)) (ErrorCore.constantConditionErrorValue x))}]}) + -- | Encoder for hydra.error.core.DuplicateBindingError duplicateBindingError :: ErrorCore.DuplicateBindingError -> Core.Term duplicateBindingError x = @@ -33,6 +37,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.duplicateBindingErrorName x))}]}) + -- | Encoder for hydra.error.core.DuplicateFieldError duplicateFieldError :: ErrorCore.DuplicateFieldError -> Core.Term duplicateFieldError x = @@ -45,6 +50,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.duplicateFieldErrorName x))}]}) + -- | Encoder for hydra.error.core.DuplicateRecordTypeFieldNamesError duplicateRecordTypeFieldNamesError :: ErrorCore.DuplicateRecordTypeFieldNamesError -> Core.Term duplicateRecordTypeFieldNamesError x = @@ -57,6 +63,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.duplicateRecordTypeFieldNamesErrorName x))}]}) + -- | Encoder for hydra.error.core.DuplicateUnionTypeFieldNamesError duplicateUnionTypeFieldNamesError :: ErrorCore.DuplicateUnionTypeFieldNamesError -> Core.Term duplicateUnionTypeFieldNamesError x = @@ -69,6 +76,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.duplicateUnionTypeFieldNamesErrorName x))}]}) + -- | Encoder for hydra.error.core.EmptyCaseStatementError emptyCaseStatementError :: ErrorCore.EmptyCaseStatementError -> Core.Term emptyCaseStatementError x = @@ -81,6 +89,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (EncodeCore.name (ErrorCore.emptyCaseStatementErrorTypeName x))}]}) + -- | Encoder for hydra.error.core.EmptyLetBindingsError emptyLetBindingsError :: ErrorCore.EmptyLetBindingsError -> Core.Term emptyLetBindingsError x = @@ -90,6 +99,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyLetBindingsErrorLocation x))}]}) + -- | Encoder for hydra.error.core.EmptyRecordTypeError emptyRecordTypeError :: ErrorCore.EmptyRecordTypeError -> Core.Term emptyRecordTypeError x = @@ -99,6 +109,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyRecordTypeErrorLocation x))}]}) + -- | Encoder for hydra.error.core.EmptyTermAnnotationError emptyTermAnnotationError :: ErrorCore.EmptyTermAnnotationError -> Core.Term emptyTermAnnotationError x = @@ -108,6 +119,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyTermAnnotationErrorLocation x))}]}) + -- | Encoder for hydra.error.core.EmptyTypeAnnotationError emptyTypeAnnotationError :: ErrorCore.EmptyTypeAnnotationError -> Core.Term emptyTypeAnnotationError x = @@ -117,6 +129,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyTypeAnnotationErrorLocation x))}]}) + -- | Encoder for hydra.error.core.EmptyTypeNameInTermError emptyTypeNameInTermError :: ErrorCore.EmptyTypeNameInTermError -> Core.Term emptyTypeNameInTermError x = @@ -126,6 +139,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyTypeNameInTermErrorLocation x))}]}) + -- | Encoder for hydra.error.core.EmptyUnionTypeError emptyUnionTypeError :: ErrorCore.EmptyUnionTypeError -> Core.Term emptyUnionTypeError x = @@ -135,6 +149,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyUnionTypeErrorLocation x))}]}) + -- | Encoder for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: ErrorCore.InvalidForallParameterNameError -> Core.Term invalidForallParameterNameError x = @@ -147,6 +162,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.invalidForallParameterNameErrorName x))}]}) + -- | Encoder for hydra.error.core.InvalidLambdaParameterNameError invalidLambdaParameterNameError :: ErrorCore.InvalidLambdaParameterNameError -> Core.Term invalidLambdaParameterNameError x = @@ -159,6 +175,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.invalidLambdaParameterNameErrorName x))}]}) + -- | Encoder for hydra.error.core.InvalidLetBindingNameError invalidLetBindingNameError :: ErrorCore.InvalidLetBindingNameError -> Core.Term invalidLetBindingNameError x = @@ -171,6 +188,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.invalidLetBindingNameErrorName x))}]}) + -- | Encoder for hydra.error.core.InvalidLiteralError invalidLiteralError :: ErrorCore.InvalidLiteralError -> Core.Term invalidLiteralError x = @@ -180,6 +198,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeMismatch"), Core.fieldTerm = (literalTypeMismatchError v0)}}) + -- | Encoder for hydra.error.core.InvalidTermError invalidTermError :: ErrorCore.InvalidTermError -> Core.Term invalidTermError x = @@ -294,6 +313,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "untypedTermVariable"), Core.fieldTerm = (untypedTermVariableError v0)}}) + -- | Encoder for hydra.error.core.InvalidTypeError invalidTypeError :: ErrorCore.InvalidTypeError -> Core.Term invalidTypeError x = @@ -368,6 +388,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "voidInNonBottomPosition"), Core.fieldTerm = (voidInNonBottomPositionError v0)}}) + -- | Encoder for hydra.error.core.InvalidTypeLambdaParameterNameError invalidTypeLambdaParameterNameError :: ErrorCore.InvalidTypeLambdaParameterNameError -> Core.Term invalidTypeLambdaParameterNameError x = @@ -380,6 +401,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.invalidTypeLambdaParameterNameErrorName x))}]}) + -- | Encoder for hydra.error.core.InvalidTypeSchemeVariableNameError invalidTypeSchemeVariableNameError :: ErrorCore.InvalidTypeSchemeVariableNameError -> Core.Term invalidTypeSchemeVariableNameError x = @@ -392,6 +414,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.invalidTypeSchemeVariableNameErrorName x))}]}) + -- | Encoder for hydra.error.core.LiteralTypeMismatchError literalTypeMismatchError :: ErrorCore.LiteralTypeMismatchError -> Core.Term literalTypeMismatchError x = @@ -404,6 +427,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (EncodeCore.literalType (ErrorCore.literalTypeMismatchErrorActualType x))}]}) + -- | Encoder for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: ErrorCore.NestedTermAnnotationError -> Core.Term nestedTermAnnotationError x = @@ -413,6 +437,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.nestedTermAnnotationErrorLocation x))}]}) + -- | Encoder for hydra.error.core.NestedTypeAnnotationError nestedTypeAnnotationError :: ErrorCore.NestedTypeAnnotationError -> Core.Term nestedTypeAnnotationError x = @@ -422,6 +447,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.nestedTypeAnnotationErrorLocation x))}]}) + -- | Encoder for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: ErrorCore.NonComparableMapKeyTypeError -> Core.Term nonComparableMapKeyTypeError x = @@ -434,6 +460,7 @@ Core.Field { Core.fieldName = (Core.Name "keyType"), Core.fieldTerm = (EncodeCore.type_ (ErrorCore.nonComparableMapKeyTypeErrorKeyType x))}]}) + -- | Encoder for hydra.error.core.NonComparableSetElementTypeError nonComparableSetElementTypeError :: ErrorCore.NonComparableSetElementTypeError -> Core.Term nonComparableSetElementTypeError x = @@ -446,6 +473,7 @@ Core.Field { Core.fieldName = (Core.Name "elementType"), Core.fieldTerm = (EncodeCore.type_ (ErrorCore.nonComparableSetElementTypeErrorElementType x))}]}) + -- | Encoder for hydra.error.core.RedundantWrapUnwrapError redundantWrapUnwrapError :: ErrorCore.RedundantWrapUnwrapError -> Core.Term redundantWrapUnwrapError x = @@ -458,6 +486,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (EncodeCore.name (ErrorCore.redundantWrapUnwrapErrorTypeName x))}]}) + -- | Encoder for hydra.error.core.SelfApplicationError selfApplicationError :: ErrorCore.SelfApplicationError -> Core.Term selfApplicationError x = @@ -470,6 +499,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.selfApplicationErrorName x))}]}) + -- | Encoder for hydra.error.core.SingleVariantUnionError singleVariantUnionError :: ErrorCore.SingleVariantUnionError -> Core.Term singleVariantUnionError x = @@ -482,6 +512,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (EncodeCore.name (ErrorCore.singleVariantUnionErrorFieldName x))}]}) + -- | Encoder for hydra.error.core.TermVariableShadowingError termVariableShadowingError :: ErrorCore.TermVariableShadowingError -> Core.Term termVariableShadowingError x = @@ -494,6 +525,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.termVariableShadowingErrorName x))}]}) + -- | Encoder for hydra.error.core.TypeVariableShadowingInForallError typeVariableShadowingInForallError :: ErrorCore.TypeVariableShadowingInForallError -> Core.Term typeVariableShadowingInForallError x = @@ -506,6 +538,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.typeVariableShadowingInForallErrorName x))}]}) + -- | Encoder for hydra.error.core.TypeVariableShadowingInTypeLambdaError typeVariableShadowingInTypeLambdaError :: ErrorCore.TypeVariableShadowingInTypeLambdaError -> Core.Term typeVariableShadowingInTypeLambdaError x = @@ -518,6 +551,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.typeVariableShadowingInTypeLambdaErrorName x))}]}) + -- | Encoder for hydra.error.core.UndefinedFieldError undefinedFieldError :: ErrorCore.UndefinedFieldError -> Core.Term undefinedFieldError x = @@ -530,6 +564,7 @@ Core.Field { Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedFieldErrorTypeName x))}]}) + -- | Encoder for hydra.error.core.UndefinedTermVariableError undefinedTermVariableError :: ErrorCore.UndefinedTermVariableError -> Core.Term undefinedTermVariableError x = @@ -542,6 +577,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedTermVariableErrorName x))}]}) + -- | Encoder for hydra.error.core.UndefinedTypeVariableError undefinedTypeVariableError :: ErrorCore.UndefinedTypeVariableError -> Core.Term undefinedTypeVariableError x = @@ -554,6 +590,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedTypeVariableErrorName x))}]}) + -- | Encoder for hydra.error.core.UndefinedTypeVariableInBindingTypeError undefinedTypeVariableInBindingTypeError :: ErrorCore.UndefinedTypeVariableInBindingTypeError -> Core.Term undefinedTypeVariableInBindingTypeError x = @@ -566,6 +603,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedTypeVariableInBindingTypeErrorName x))}]}) + -- | Encoder for hydra.error.core.UndefinedTypeVariableInLambdaDomainError undefinedTypeVariableInLambdaDomainError :: ErrorCore.UndefinedTypeVariableInLambdaDomainError -> Core.Term undefinedTypeVariableInLambdaDomainError x = @@ -578,6 +616,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedTypeVariableInLambdaDomainErrorName x))}]}) + -- | Encoder for hydra.error.core.UndefinedTypeVariableInTypeApplicationError undefinedTypeVariableInTypeApplicationError :: ErrorCore.UndefinedTypeVariableInTypeApplicationError -> Core.Term undefinedTypeVariableInTypeApplicationError x = @@ -590,6 +629,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.undefinedTypeVariableInTypeApplicationErrorName x))}]}) + -- | Encoder for hydra.error.core.UnexpectedTermVariantError unexpectedTermVariantError :: ErrorCore.UnexpectedTermVariantError -> Core.Term unexpectedTermVariantError x = @@ -602,6 +642,7 @@ Core.Field { Core.fieldName = (Core.Name "actualTerm"), Core.fieldTerm = (EncodeCore.term (ErrorCore.unexpectedTermVariantErrorActualTerm x))}]}) + -- | Encoder for hydra.error.core.UnexpectedTypeVariantError unexpectedTypeVariantError :: ErrorCore.UnexpectedTypeVariantError -> Core.Term unexpectedTypeVariantError x = @@ -614,6 +655,7 @@ Core.Field { Core.fieldName = (Core.Name "actualType"), Core.fieldTerm = (EncodeCore.type_ (ErrorCore.unexpectedTypeVariantErrorActualType x))}]}) + -- | Encoder for hydra.error.core.UnknownPrimitiveNameError unknownPrimitiveNameError :: ErrorCore.UnknownPrimitiveNameError -> Core.Term unknownPrimitiveNameError x = @@ -626,6 +668,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownPrimitiveNameErrorName x))}]}) + -- | Encoder for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: ErrorCore.UnnecessaryIdentityApplicationError -> Core.Term unnecessaryIdentityApplicationError x = @@ -635,6 +678,7 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.unnecessaryIdentityApplicationErrorLocation x))}]}) + -- | Encoder for hydra.error.core.UntypedTermVariableError untypedTermVariableError :: ErrorCore.UntypedTermVariableError -> Core.Term untypedTermVariableError x = @@ -647,6 +691,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.untypedTermVariableErrorName x))}]}) + -- | Encoder for hydra.error.core.VoidInNonBottomPositionError voidInNonBottomPositionError :: ErrorCore.VoidInNonBottomPositionError -> Core.Term voidInNonBottomPositionError x = diff --git a/src/main/haskell/Hydra/Encode/Error/File.hs b/src/main/haskell/Hydra/Encode/Error/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/Error/File.hs @@ -0,0 +1,41 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.error.file + +module Hydra.Encode.Error.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Encode.File as EncodeFile +import qualified Hydra.Error.File as ErrorFile +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.error.file.FileError +fileError :: ErrorFile.FileError -> Core.Term +fileError x = + case x of + ErrorFile.FileErrorAlreadyExists v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "alreadyExists"), + Core.fieldTerm = (EncodeFile.filePath v0)}}) + ErrorFile.FileErrorInvalidPath v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "invalidPath"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + ErrorFile.FileErrorNotFound v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "notFound"), + Core.fieldTerm = (EncodeFile.filePath v0)}}) + ErrorFile.FileErrorOther v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "other"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + ErrorFile.FileErrorPermissionDenied v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.file.FileError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "permissionDenied"), + Core.fieldTerm = (EncodeFile.filePath v0)}}) 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 @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.error.packaging module Hydra.Encode.Error.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Packaging as EncodePackaging @@ -9,6 +11,7 @@ import qualified Hydra.Error.Packaging as ErrorPackaging import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.error.packaging.ConflictingModuleNameError conflictingModuleNameError :: ErrorPackaging.ConflictingModuleNameError -> Core.Term conflictingModuleNameError x = @@ -21,6 +24,7 @@ Core.Field { Core.fieldName = (Core.Name "second"), Core.fieldTerm = (EncodePackaging.moduleName (ErrorPackaging.conflictingModuleNameErrorSecond x))}]}) + -- | Encoder for hydra.error.packaging.ConflictingVariantNameError conflictingVariantNameError :: ErrorPackaging.ConflictingVariantNameError -> Core.Term conflictingVariantNameError x = @@ -39,6 +43,7 @@ Core.Field { Core.fieldName = (Core.Name "conflictingName"), Core.fieldTerm = (EncodeCore.name (ErrorPackaging.conflictingVariantNameErrorConflictingName x))}]}) + -- | Encoder for hydra.error.packaging.DefinitionNotInModuleNameError definitionNotInModuleNameError :: ErrorPackaging.DefinitionNotInModuleNameError -> Core.Term definitionNotInModuleNameError x = @@ -51,6 +56,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorPackaging.definitionNotInModuleNameErrorName x))}]}) + -- | Encoder for hydra.error.packaging.DefinitionsOutOfOrderError definitionsOutOfOrderError :: ErrorPackaging.DefinitionsOutOfOrderError -> Core.Term definitionsOutOfOrderError x = @@ -66,6 +72,7 @@ Core.Field { Core.fieldName = (Core.Name "followingName"), Core.fieldTerm = (EncodeCore.name (ErrorPackaging.definitionsOutOfOrderErrorFollowingName x))}]}) + -- | Encoder for hydra.error.packaging.DuplicateDefinitionNameError duplicateDefinitionNameError :: ErrorPackaging.DuplicateDefinitionNameError -> Core.Term duplicateDefinitionNameError x = @@ -78,6 +85,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorPackaging.duplicateDefinitionNameErrorName x))}]}) + -- | Encoder for hydra.error.packaging.DuplicateModuleNameError duplicateModuleNameError :: ErrorPackaging.DuplicateModuleNameError -> Core.Term duplicateModuleNameError x = @@ -87,6 +95,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (EncodePackaging.moduleName (ErrorPackaging.duplicateModuleNameErrorModuleName x))}]}) + -- | Encoder for hydra.error.packaging.InvalidDefinitionNameError invalidDefinitionNameError :: ErrorPackaging.InvalidDefinitionNameError -> Core.Term invalidDefinitionNameError x = @@ -102,6 +111,7 @@ Core.Field { Core.fieldName = (Core.Name "expectedConvention"), Core.fieldTerm = (Util.caseConvention (ErrorPackaging.invalidDefinitionNameErrorExpectedConvention x))}]}) + -- | Encoder for hydra.error.packaging.InvalidModuleError invalidModuleError :: ErrorPackaging.InvalidModuleError -> Core.Term invalidModuleError x = @@ -141,6 +151,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "missingDocumentation"), Core.fieldTerm = (missingDocumentationError v0)}}) + -- | Encoder for hydra.error.packaging.InvalidModuleNameConventionError invalidModuleNameConventionError :: ErrorPackaging.InvalidModuleNameConventionError -> Core.Term invalidModuleNameConventionError x = @@ -150,6 +161,7 @@ Core.Field { Core.fieldName = (Core.Name "moduleName"), Core.fieldTerm = (EncodePackaging.moduleName (ErrorPackaging.invalidModuleNameConventionErrorModuleName x))}]}) + -- | Encoder for hydra.error.packaging.InvalidPackageError invalidPackageError :: ErrorPackaging.InvalidPackageError -> Core.Term invalidPackageError x = @@ -174,6 +186,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "invalidPackageName"), Core.fieldTerm = (invalidPackageNameError v0)}}) + -- | Encoder for hydra.error.packaging.InvalidPackageNameError invalidPackageNameError :: ErrorPackaging.InvalidPackageNameError -> Core.Term invalidPackageNameError x = @@ -183,6 +196,7 @@ Core.Field { Core.fieldName = (Core.Name "packageName"), Core.fieldTerm = (EncodePackaging.packageName (ErrorPackaging.invalidPackageNameErrorPackageName x))}]}) + -- | Encoder for hydra.error.packaging.MissingDocumentationError missingDocumentationError :: ErrorPackaging.MissingDocumentationError -> Core.Term missingDocumentationError x = diff --git a/src/main/haskell/Hydra/Encode/Error/System.hs b/src/main/haskell/Hydra/Encode/Error/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/Error/System.hs @@ -0,0 +1,41 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.error.system + +module Hydra.Encode.Error.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Encode.File as File +import qualified Hydra.Error.System as System +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.error.system.SystemError +systemError :: System.SystemError -> Core.Term +systemError x = + case x of + System.SystemErrorCommandNotFound v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "commandNotFound"), + Core.fieldTerm = (File.filePath v0)}}) + System.SystemErrorPermissionDenied v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "permissionDenied"), + Core.fieldTerm = (File.filePath v0)}}) + System.SystemErrorInvalidWorkingDirectory v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "invalidWorkingDirectory"), + Core.fieldTerm = (File.filePath v0)}}) + System.SystemErrorInterrupted -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "interrupted"), + Core.fieldTerm = Core.TermUnit}}) + System.SystemErrorOther v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.error.system.SystemError"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "other"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) diff --git a/src/main/haskell/Hydra/Encode/Errors.hs b/src/main/haskell/Hydra/Encode/Errors.hs --- a/src/main/haskell/Hydra/Encode/Errors.hs +++ b/src/main/haskell/Hydra/Encode/Errors.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.errors module Hydra.Encode.Errors where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Error.Checking as Checking @@ -12,15 +14,18 @@ import qualified Hydra.Errors as Errors import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.errors.DecodingError decodingError :: Errors.DecodingError -> Core.Term decodingError x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.DecodingError"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.unDecodingError x))}) + -- | Encoder for hydra.errors.EmptyListError emptyListError :: () -> Core.Term emptyListError _ = Core.TermUnit + -- | Encoder for hydra.errors.Error error :: Errors.Error -> Core.Term error x = @@ -100,6 +105,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unification"), Core.fieldTerm = (unificationError v0)}}) + -- | Encoder for hydra.errors.ExtractionError extractionError :: Errors.ExtractionError -> Core.Term extractionError x = @@ -139,6 +145,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedShape"), Core.fieldTerm = (unexpectedShapeError v0)}}) + -- | Encoder for hydra.errors.InferenceError inferenceError :: Errors.InferenceError -> Core.Term inferenceError x = @@ -158,6 +165,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unification"), Core.fieldTerm = (unificationInferenceError v0)}}) + -- | Encoder for hydra.errors.MultipleBindingsError multipleBindingsError :: Errors.MultipleBindingsError -> Core.Term multipleBindingsError x = @@ -167,6 +175,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (Errors.multipleBindingsErrorName x))}]}) + -- | Encoder for hydra.errors.MultipleFieldsError multipleFieldsError :: Errors.MultipleFieldsError -> Core.Term multipleFieldsError x = @@ -176,6 +185,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (EncodeCore.name (Errors.multipleFieldsErrorFieldName x))}]}) + -- | Encoder for hydra.errors.NoMatchingFieldError noMatchingFieldError :: Errors.NoMatchingFieldError -> Core.Term noMatchingFieldError x = @@ -185,6 +195,7 @@ Core.Field { Core.fieldName = (Core.Name "fieldName"), Core.fieldTerm = (EncodeCore.name (Errors.noMatchingFieldErrorFieldName x))}]}) + -- | Encoder for hydra.errors.NoSuchBindingError noSuchBindingError :: Errors.NoSuchBindingError -> Core.Term noSuchBindingError x = @@ -194,6 +205,7 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (Errors.noSuchBindingErrorName x))}]}) + -- | Encoder for hydra.errors.NoSuchPrimitiveError noSuchPrimitiveError :: Errors.NoSuchPrimitiveError -> Core.Term noSuchPrimitiveError x = @@ -203,15 +215,18 @@ Core.Field { Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (Errors.noSuchPrimitiveErrorName x))}]}) + -- | Encoder for hydra.errors.NotEnoughCasesError notEnoughCasesError :: () -> Core.Term notEnoughCasesError _ = Core.TermUnit + -- | Encoder for hydra.errors.OtherError otherError :: Errors.OtherError -> Core.Term otherError x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherError"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.unOtherError x))}) + -- | Encoder for hydra.errors.OtherInferenceError otherInferenceError :: Errors.OtherInferenceError -> Core.Term otherInferenceError x = @@ -224,12 +239,14 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.otherInferenceErrorMessage x))}]}) + -- | Encoder for hydra.errors.OtherResolutionError otherResolutionError :: Errors.OtherResolutionError -> Core.Term otherResolutionError x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.errors.OtherResolutionError"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.unOtherResolutionError x))}) + -- | Encoder for hydra.errors.ResolutionError resolutionError :: Errors.ResolutionError -> Core.Term resolutionError x = @@ -259,6 +276,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unexpectedShape"), Core.fieldTerm = (unexpectedShapeError v0)}}) + -- | Encoder for hydra.errors.UnexpectedShapeError unexpectedShapeError :: Errors.UnexpectedShapeError -> Core.Term unexpectedShapeError x = @@ -271,6 +289,7 @@ Core.Field { Core.fieldName = (Core.Name "actual"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.unexpectedShapeErrorActual x))}]}) + -- | Encoder for hydra.errors.UnificationError unificationError :: Errors.UnificationError -> Core.Term unificationError x = @@ -286,6 +305,7 @@ Core.Field { Core.fieldName = (Core.Name "message"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Errors.unificationErrorMessage x))}]}) + -- | Encoder for hydra.errors.UnificationInferenceError unificationInferenceError :: Errors.UnificationInferenceError -> Core.Term unificationInferenceError x = diff --git a/src/main/haskell/Hydra/Encode/File.hs b/src/main/haskell/Hydra/Encode/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/File.hs @@ -0,0 +1,89 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.file + +module Hydra.Encode.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Encode.Time as Time +import qualified Hydra.File as File +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.file.FileExtension +fileExtension :: File.FileExtension -> Core.Term +fileExtension x = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.file.FileExtension"), + Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (File.unFileExtension x))}) + +-- | Encoder for hydra.file.FilePath +filePath :: File.FilePath -> Core.Term +filePath x = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.file.FilePath"), + Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (File.unFilePath x))}) + +-- | Encoder for hydra.file.FileStatus +fileStatus :: File.FileStatus -> Core.Term +fileStatus x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.file.FileStatus"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "fileType"), + Core.fieldTerm = (fileType (File.fileStatusFileType x))}, + Core.Field { + Core.fieldName = (Core.Name "size"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 x2))) (File.fileStatusSize x))}, + Core.Field { + Core.fieldName = (Core.Name "modificationTime"), + Core.fieldTerm = (Time.timespec (File.fileStatusModificationTime x))}, + Core.Field { + Core.fieldName = (Core.Name "accessTime"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map Time.timespec opt)) (File.fileStatusAccessTime x))}, + Core.Field { + Core.fieldName = (Core.Name "statusChangeTime"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map Time.timespec opt)) (File.fileStatusStatusChangeTime x))}]}) + +-- | Encoder for hydra.file.FileType +fileType :: File.FileType -> Core.Term +fileType x = + case x of + File.FileTypeBlock -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "block"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeCharacter -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "character"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeDirectory -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "directory"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeFifo -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "fifo"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeRegular -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "regular"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeLink -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "link"), + Core.fieldTerm = Core.TermUnit}}) + File.FileTypeSocket -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.file.FileType"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "socket"), + Core.fieldTerm = Core.TermUnit}}) diff --git a/src/main/haskell/Hydra/Encode/Json/Model.hs b/src/main/haskell/Hydra/Encode/Json/Model.hs --- a/src/main/haskell/Hydra/Encode/Json/Model.hs +++ b/src/main/haskell/Hydra/Encode/Json/Model.hs @@ -1,14 +1,17 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.json.model module Hydra.Encode.Json.Model where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Json.Model as Model -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.json.model.Value value :: Model.Value -> Core.Term value x = diff --git a/src/main/haskell/Hydra/Encode/Packaging.hs b/src/main/haskell/Hydra/Encode/Packaging.hs --- a/src/main/haskell/Hydra/Encode/Packaging.hs +++ b/src/main/haskell/Hydra/Encode/Packaging.hs @@ -1,19 +1,27 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.packaging module Hydra.Encode.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Typing as Typing -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals import qualified Hydra.Packaging as Packaging import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.packaging.Definition definition :: Packaging.Definition -> Core.Term definition x = case x of + Packaging.DefinitionPrimitive v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.Definition"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "primitive"), + Core.fieldTerm = (primitiveDefinition v0)}}) Packaging.DefinitionTerm v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.Definition"), Core.injectionField = Core.Field { @@ -24,30 +32,52 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (typeDefinition v0)}}) - Packaging.DefinitionPrimitive v0 -> Core.TermInject (Core.Injection { - Core.injectionTypeName = (Core.Name "hydra.packaging.Definition"), - Core.injectionField = Core.Field { - Core.fieldName = (Core.Name "primitive"), - Core.fieldTerm = (primitiveDefinition v0)}}) + -- | Encoder for hydra.packaging.DefinitionReference definitionReference :: Packaging.DefinitionReference -> Core.Term definitionReference x = case x of - Packaging.DefinitionReferenceType v0 -> Core.TermInject (Core.Injection { + Packaging.DefinitionReferencePrimitive v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.DefinitionReference"), Core.injectionField = Core.Field { - Core.fieldName = (Core.Name "type"), + Core.fieldName = (Core.Name "primitive"), Core.fieldTerm = (EncodeCore.name v0)}}) Packaging.DefinitionReferenceTerm v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.DefinitionReference"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (EncodeCore.name v0)}}) - Packaging.DefinitionReferencePrimitive v0 -> Core.TermInject (Core.Injection { + Packaging.DefinitionReferenceType v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.DefinitionReference"), Core.injectionField = Core.Field { - Core.fieldName = (Core.Name "primitive"), + Core.fieldName = (Core.Name "type"), Core.fieldTerm = (EncodeCore.name v0)}}) + +-- | Encoder for hydra.packaging.DependencyScope +dependencyScope :: Packaging.DependencyScope -> Core.Term +dependencyScope x = + case x of + Packaging.DependencyScopeApi -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "api"), + Core.fieldTerm = Core.TermUnit}}) + Packaging.DependencyScopeRuntime -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "runtime"), + Core.fieldTerm = Core.TermUnit}}) + Packaging.DependencyScopeTest -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "test"), + Core.fieldTerm = Core.TermUnit}}) + Packaging.DependencyScopeTool -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.DependencyScope"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "tool"), + Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.packaging.EntityMetadata entityMetadata :: Packaging.EntityMetadata -> Core.Term entityMetadata x = @@ -66,25 +96,37 @@ Core.Field { Core.fieldName = (Core.Name "lifecycle"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map lifecycleInfo opt)) (Packaging.entityMetadataLifecycle x))}]}) + -- | Encoder for hydra.packaging.EntityReference entityReference :: Packaging.EntityReference -> Core.Term entityReference x = case x of - Packaging.EntityReferencePackage v0 -> Core.TermInject (Core.Injection { + Packaging.EntityReferenceDefinition v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), Core.injectionField = Core.Field { - Core.fieldName = (Core.Name "package"), - Core.fieldTerm = (packageName v0)}}) + Core.fieldName = (Core.Name "definition"), + Core.fieldTerm = (definitionReference v0)}}) Packaging.EntityReferenceModule v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "module"), Core.fieldTerm = (moduleName v0)}}) - Packaging.EntityReferenceDefinition v0 -> Core.TermInject (Core.Injection { + Packaging.EntityReferencePackage v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), Core.injectionField = Core.Field { - Core.fieldName = (Core.Name "definition"), - Core.fieldTerm = (definitionReference v0)}}) + Core.fieldName = (Core.Name "package"), + Core.fieldTerm = (packageName v0)}}) + Packaging.EntityReferenceTermExpr v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "termExpr"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + Packaging.EntityReferenceTypeExpr v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.EntityReference"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "typeExpr"), + Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v0))}}) + -- | Encoder for hydra.packaging.LifecycleInfo lifecycleInfo :: Packaging.LifecycleInfo -> Core.Term lifecycleInfo x = @@ -97,6 +139,7 @@ Core.Field { Core.fieldName = (Core.Name "deprecatedSince"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map version opt)) (Packaging.lifecycleInfoDeprecatedSince x))}]}) + -- | Encoder for hydra.packaging.Module module_ :: Packaging.Module -> Core.Term module_ x = @@ -115,6 +158,7 @@ Core.Field { Core.fieldName = (Core.Name "definitions"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map definition xs)) (Packaging.moduleDefinitions x))}]}) + -- | Encoder for hydra.packaging.ModuleDependency moduleDependency :: Packaging.ModuleDependency -> Core.Term moduleDependency x = @@ -127,12 +171,14 @@ Core.Field { Core.fieldName = (Core.Name "package"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map packageName opt)) (Packaging.moduleDependencyPackage x))}]}) + -- | Encoder for hydra.packaging.ModuleName moduleName :: Packaging.ModuleName -> Core.Term moduleName x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.ModuleName"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Packaging.unModuleName x))}) + -- | Encoder for hydra.packaging.Package package :: Packaging.Package -> Core.Term package x = @@ -151,6 +197,7 @@ Core.Field { Core.fieldName = (Core.Name "modules"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map module_ xs)) (Packaging.packageModules x))}]}) + -- | Encoder for hydra.packaging.PackageDependency packageDependency :: Packaging.PackageDependency -> Core.Term packageDependency x = @@ -162,13 +209,18 @@ Core.fieldTerm = (packageName (Packaging.packageDependencyName x))}, Core.Field { Core.fieldName = (Core.Name "version"), - Core.fieldTerm = (versionSpecifier (Packaging.packageDependencyVersion x))}]}) + Core.fieldTerm = (versionSpecifier (Packaging.packageDependencyVersion x))}, + Core.Field { + Core.fieldName = (Core.Name "scope"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map dependencyScope opt)) (Packaging.packageDependencyScope x))}]}) + -- | Encoder for hydra.packaging.PackageName packageName :: Packaging.PackageName -> Core.Term packageName x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.PackageName"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Packaging.unPackageName x))}) + -- | Encoder for hydra.packaging.PrimitiveDefinition primitiveDefinition :: Packaging.PrimitiveDefinition -> Core.Term primitiveDefinition x = @@ -193,6 +245,7 @@ Core.Field { Core.fieldName = (Core.Name "defaultImplementation"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map EncodeCore.term opt)) (Packaging.primitiveDefinitionDefaultImplementation x))}]}) + -- | Encoder for hydra.packaging.TermDefinition termDefinition :: Packaging.TermDefinition -> Core.Term termDefinition x = @@ -211,6 +264,7 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (EncodeCore.term (Packaging.termDefinitionBody x))}]}) + -- | Encoder for hydra.packaging.TypeDefinition typeDefinition :: Packaging.TypeDefinition -> Core.Term typeDefinition x = @@ -226,12 +280,27 @@ Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (EncodeCore.typeScheme (Packaging.typeDefinitionBody x))}]}) + -- | Encoder for hydra.packaging.Version version :: Packaging.Version -> Core.Term version x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.packaging.Version"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Packaging.unVersion x))}) + +-- | Encoder for hydra.packaging.VersionRange +versionRange :: Packaging.VersionRange -> Core.Term +versionRange x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.packaging.VersionRange"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "lowerInclusive"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map version opt)) (Packaging.versionRangeLowerInclusive x))}, + Core.Field { + Core.fieldName = (Core.Name "upperExclusive"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map version opt)) (Packaging.versionRangeUpperExclusive x))}]}) + -- | Encoder for hydra.packaging.VersionSpecifier versionSpecifier :: Packaging.VersionSpecifier -> Core.Term versionSpecifier x = @@ -241,3 +310,18 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "any"), Core.fieldTerm = Core.TermUnit}}) + Packaging.VersionSpecifierExact v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "exact"), + Core.fieldTerm = (version v0)}}) + Packaging.VersionSpecifierAtLeast v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "atLeast"), + Core.fieldTerm = (version v0)}}) + Packaging.VersionSpecifierRange v0 -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.packaging.VersionSpecifier"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "range"), + Core.fieldTerm = (versionRange v0)}}) diff --git a/src/main/haskell/Hydra/Encode/Parsing.hs b/src/main/haskell/Hydra/Encode/Parsing.hs --- a/src/main/haskell/Hydra/Encode/Parsing.hs +++ b/src/main/haskell/Hydra/Encode/Parsing.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.parsing module Hydra.Encode.Parsing where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Parsing as Parsing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.parsing.ParseError parseError :: Parsing.ParseError -> Core.Term parseError x = @@ -19,6 +22,7 @@ Core.Field { Core.fieldName = (Core.Name "remainder"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Parsing.parseErrorRemainder x))}]}) + -- | Encoder for hydra.parsing.ParseResult parseResult :: (a -> Core.Term) -> Parsing.ParseResult a -> Core.Term parseResult a x = @@ -33,6 +37,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "failure"), Core.fieldTerm = (parseError v0)}}) + -- | Encoder for hydra.parsing.ParseSuccess parseSuccess :: (a -> Core.Term) -> Parsing.ParseSuccess a -> Core.Term parseSuccess a x = diff --git a/src/main/haskell/Hydra/Encode/Paths.hs b/src/main/haskell/Hydra/Encode/Paths.hs --- a/src/main/haskell/Hydra/Encode/Paths.hs +++ b/src/main/haskell/Hydra/Encode/Paths.hs @@ -1,13 +1,16 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.paths module Hydra.Encode.Paths where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Paths as Paths import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.paths.SubtermEdge subtermEdge :: Paths.SubtermEdge -> Core.Term subtermEdge x = @@ -23,6 +26,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (subtermNode (Paths.subtermEdgeTarget x))}]}) + -- | Encoder for hydra.paths.SubtermGraph subtermGraph :: Paths.SubtermGraph -> Core.Term subtermGraph x = @@ -35,6 +39,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map subtermEdge xs)) (Paths.subtermGraphEdges x))}]}) + -- | Encoder for hydra.paths.SubtermNode subtermNode :: Paths.SubtermNode -> Core.Term subtermNode x = @@ -50,12 +55,14 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Paths.subtermNodeId x))}]}) + -- | Encoder for hydra.paths.SubtermPath subtermPath :: Paths.SubtermPath -> Core.Term subtermPath x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtermPath"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map subtermStep xs)) (Paths.unSubtermPath x))}) + -- | Encoder for hydra.paths.SubtermStep subtermStep :: Paths.SubtermStep -> Core.Term subtermStep x = @@ -160,6 +167,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrappedTerm"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.paths.SubtypeEdge subtypeEdge :: Paths.SubtypeEdge -> Core.Term subtypeEdge x = @@ -175,6 +183,7 @@ Core.Field { Core.fieldName = (Core.Name "target"), Core.fieldTerm = (subtypeNode (Paths.subtypeEdgeTarget x))}]}) + -- | Encoder for hydra.paths.SubtypeGraph subtypeGraph :: Paths.SubtypeGraph -> Core.Term subtypeGraph x = @@ -187,6 +196,7 @@ Core.Field { Core.fieldName = (Core.Name "edges"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map subtypeEdge xs)) (Paths.subtypeGraphEdges x))}]}) + -- | Encoder for hydra.paths.SubtypeNode subtypeNode :: Paths.SubtypeNode -> Core.Term subtypeNode x = @@ -202,12 +212,14 @@ Core.Field { Core.fieldName = (Core.Name "id"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Paths.subtypeNodeId x))}]}) + -- | Encoder for hydra.paths.SubtypePath subtypePath :: Paths.SubtypePath -> Core.Term subtypePath x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.paths.SubtypePath"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map subtypeStep xs)) (Paths.unSubtypePath x))}) + -- | Encoder for hydra.paths.SubtypeStep subtypeStep :: Paths.SubtypeStep -> Core.Term subtypeStep x = diff --git a/src/main/haskell/Hydra/Encode/Query.hs b/src/main/haskell/Hydra/Encode/Query.hs --- a/src/main/haskell/Hydra/Encode/Query.hs +++ b/src/main/haskell/Hydra/Encode/Query.hs @@ -1,14 +1,17 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.query module Hydra.Encode.Query where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals import qualified Hydra.Query as Query import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.query.ComparisonConstraint comparisonConstraint :: Query.ComparisonConstraint -> Core.Term comparisonConstraint x = @@ -43,6 +46,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "greaterThanOrEqual"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.query.Edge edge :: Query.Edge -> Core.Term edge x = @@ -58,6 +62,7 @@ Core.Field { Core.fieldName = (Core.Name "in"), Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map EncodeCore.name opt)) (Query.edgeIn x))}]}) + -- | Encoder for hydra.query.GraphPattern graphPattern :: Query.GraphPattern -> Core.Term graphPattern x = @@ -70,6 +75,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map pattern xs)) (Query.graphPatternPatterns x))}]}) + -- | Encoder for hydra.query.Node node :: Query.Node -> Core.Term node x = @@ -89,6 +95,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wildcard"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.query.Path path :: Query.Path -> Core.Term path x = @@ -108,6 +115,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "inverse"), Core.fieldTerm = (path v0)}}) + -- | Encoder for hydra.query.PathEquation pathEquation :: Query.PathEquation -> Core.Term pathEquation x = @@ -120,6 +128,7 @@ Core.Field { Core.fieldName = (Core.Name "right"), Core.fieldTerm = (path (Query.pathEquationRight x))}]}) + -- | Encoder for hydra.query.Pattern pattern :: Query.Pattern -> Core.Term pattern x = @@ -149,6 +158,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "graph"), Core.fieldTerm = (graphPattern v0)}}) + -- | Encoder for hydra.query.PatternImplication patternImplication :: Query.PatternImplication -> Core.Term patternImplication x = @@ -161,6 +171,7 @@ Core.Field { Core.fieldName = (Core.Name "consequent"), Core.fieldTerm = (pattern (Query.patternImplicationConsequent x))}]}) + -- | Encoder for hydra.query.Query query :: Query.Query -> Core.Term query x = @@ -173,6 +184,7 @@ Core.Field { Core.fieldName = (Core.Name "patterns"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map pattern xs)) (Query.queryPatterns x))}]}) + -- | Encoder for hydra.query.Range range :: Query.Range -> Core.Term range x = @@ -185,6 +197,7 @@ Core.Field { Core.fieldName = (Core.Name "max"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Query.rangeMax x))}]}) + -- | Encoder for hydra.query.RegexQuantifier regexQuantifier :: Query.RegexQuantifier -> Core.Term regexQuantifier x = @@ -224,6 +237,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "range"), Core.fieldTerm = (range v0)}}) + -- | Encoder for hydra.query.RegexSequence regexSequence :: Query.RegexSequence -> Core.Term regexSequence x = @@ -236,6 +250,7 @@ Core.Field { Core.fieldName = (Core.Name "quantifier"), Core.fieldTerm = (regexQuantifier (Query.regexSequenceQuantifier x))}]}) + -- | Encoder for hydra.query.Step step :: Query.Step -> Core.Term step x = @@ -255,6 +270,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "compare"), Core.fieldTerm = (comparisonConstraint v0)}}) + -- | Encoder for hydra.query.TriplePattern triplePattern :: Query.TriplePattern -> Core.Term triplePattern x = @@ -270,6 +286,7 @@ Core.Field { Core.fieldName = (Core.Name "object"), Core.fieldTerm = (node (Query.triplePatternObject x))}]}) + -- | Encoder for hydra.query.Variable variable :: Query.Variable -> Core.Term variable x = diff --git a/src/main/haskell/Hydra/Encode/Relational.hs b/src/main/haskell/Hydra/Encode/Relational.hs --- a/src/main/haskell/Hydra/Encode/Relational.hs +++ b/src/main/haskell/Hydra/Encode/Relational.hs @@ -1,21 +1,25 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.relational module Hydra.Encode.Relational where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Relational as Relational import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.relational.ColumnName columnName :: Relational.ColumnName -> Core.Term columnName x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.ColumnName"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Relational.unColumnName x))}) + -- | Encoder for hydra.relational.ColumnSchema columnSchema :: (t -> Core.Term) -> Relational.ColumnSchema t -> Core.Term columnSchema t x = @@ -28,6 +32,7 @@ Core.Field { Core.fieldName = (Core.Name "domain"), Core.fieldTerm = (t (Relational.columnSchemaDomain x))}]}) + -- | Encoder for hydra.relational.ForeignKey foreignKey :: Relational.ForeignKey -> Core.Term foreignKey x = @@ -40,24 +45,28 @@ Core.Field { Core.fieldName = (Core.Name "keys"), Core.fieldTerm = ((\m -> Core.TermMap (Maps.bimap columnName columnName m)) (Relational.foreignKeyKeys x))}]}) + -- | Encoder for hydra.relational.PrimaryKey primaryKey :: Relational.PrimaryKey -> Core.Term primaryKey x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.PrimaryKey"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map columnName xs)) (Relational.unPrimaryKey x))}) + -- | Encoder for hydra.relational.Relation relation :: (v -> Core.Term) -> Relational.Relation v -> Core.Term relation v x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.Relation"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map (row v) xs)) (Relational.unRelation x))}) + -- | Encoder for hydra.relational.RelationName relationName :: Relational.RelationName -> Core.Term relationName x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.RelationName"), Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Relational.unRelationName x))}) + -- | Encoder for hydra.relational.RelationSchema relationSchema :: (t -> Core.Term) -> Relational.RelationSchema t -> Core.Term relationSchema t x = @@ -76,12 +85,14 @@ Core.Field { Core.fieldName = (Core.Name "foreignKeys"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map foreignKey xs)) (Relational.relationSchemaForeignKeys x))}]}) + -- | Encoder for hydra.relational.Relationship relationship :: Ord v => ((v -> Core.Term) -> Relational.Relationship v -> Core.Term) relationship v x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.relational.Relationship"), Core.wrappedTermBody = ((\s -> Core.TermSet (Sets.map (\m -> Core.TermMap (Maps.bimap columnName v m)) s)) (Relational.unRelationship x))}) + -- | Encoder for hydra.relational.Row row :: (v -> Core.Term) -> Relational.Row v -> Core.Term row v x = diff --git a/src/main/haskell/Hydra/Encode/System.hs b/src/main/haskell/Hydra/Encode/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/System.hs @@ -0,0 +1,64 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.system + +module Hydra.Encode.System where + +import qualified Hydra.Core as Core +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Encode.File as File +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.System as System +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.system.Command +command :: System.Command -> Core.Term +command x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.Command"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "program"), + Core.fieldTerm = (File.filePath (System.commandProgram x))}, + Core.Field { + Core.fieldName = (Core.Name "arguments"), + Core.fieldTerm = ((\xs -> Core.TermList (Lists.map (\x2 -> Core.TermLiteral (Core.LiteralString x2)) xs)) (System.commandArguments x))}, + Core.Field { + Core.fieldName = (Core.Name "workingDirectory"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map File.filePath opt)) (System.commandWorkingDirectory x))}, + Core.Field { + Core.fieldName = (Core.Name "environment"), + Core.fieldTerm = ((\opt -> Core.TermOptional (Optionals.map (\m -> Core.TermMap (Maps.bimap environmentVariable (\x2 -> Core.TermLiteral (Core.LiteralString x2)) m)) opt)) (System.commandEnvironment x))}]}) + +-- | Encoder for hydra.system.EnvironmentVariable +environmentVariable :: System.EnvironmentVariable -> Core.Term +environmentVariable x = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.system.EnvironmentVariable"), + Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (System.unEnvironmentVariable x))}) + +-- | Encoder for hydra.system.ProcessResult +processResult :: System.ProcessResult -> Core.Term +processResult x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.system.ProcessResult"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "exitCode"), + Core.fieldTerm = (statusCode (System.processResultExitCode x))}, + Core.Field { + Core.fieldName = (Core.Name "stdout"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBinary x2)) (System.processResultStdout x))}, + Core.Field { + Core.fieldName = (Core.Name "stderr"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBinary x2)) (System.processResultStderr x))}]}) + +-- | Encoder for hydra.system.StatusCode +statusCode :: System.StatusCode -> Core.Term +statusCode x = + Core.TermWrap (Core.WrappedTerm { + Core.wrappedTermTypeName = (Core.Name "hydra.system.StatusCode"), + Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (System.unStatusCode x))}) diff --git a/src/main/haskell/Hydra/Encode/Tabular.hs b/src/main/haskell/Hydra/Encode/Tabular.hs --- a/src/main/haskell/Hydra/Encode/Tabular.hs +++ b/src/main/haskell/Hydra/Encode/Tabular.hs @@ -1,15 +1,18 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.tabular module Hydra.Encode.Tabular where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Relational as Relational -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals import qualified Hydra.Tabular as Tabular import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.tabular.ColumnType columnType :: Tabular.ColumnType -> Core.Term columnType x = @@ -22,18 +25,21 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (EncodeCore.type_ (Tabular.columnTypeType x))}]}) + -- | Encoder for hydra.tabular.DataRow dataRow :: (v -> Core.Term) -> Tabular.DataRow v -> Core.Term dataRow v x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.tabular.DataRow"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map (\opt -> Core.TermOptional (Optionals.map v opt)) xs)) (Tabular.unDataRow x))}) + -- | Encoder for hydra.tabular.HeaderRow headerRow :: Tabular.HeaderRow -> Core.Term headerRow x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.tabular.HeaderRow"), Core.wrappedTermBody = ((\xs -> Core.TermList (Lists.map (\x2 -> Core.TermLiteral (Core.LiteralString x2)) xs)) (Tabular.unHeaderRow x))}) + -- | Encoder for hydra.tabular.Table table :: (v -> Core.Term) -> Tabular.Table v -> Core.Term table v x = @@ -46,6 +52,7 @@ Core.Field { Core.fieldName = (Core.Name "data"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map (dataRow v) xs)) (Tabular.tableData x))}]}) + -- | Encoder for hydra.tabular.TableType tableType :: Tabular.TableType -> Core.Term tableType x = diff --git a/src/main/haskell/Hydra/Encode/Testing.hs b/src/main/haskell/Hydra/Encode/Testing.hs --- a/src/main/haskell/Hydra/Encode/Testing.hs +++ b/src/main/haskell/Hydra/Encode/Testing.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.testing module Hydra.Encode.Testing where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Testing as Testing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.testing.Tag tag :: Testing.Tag -> Core.Term tag x = diff --git a/src/main/haskell/Hydra/Encode/Time.hs b/src/main/haskell/Hydra/Encode/Time.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Encode/Time.hs @@ -0,0 +1,24 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Term encoders for hydra.time + +module Hydra.Encode.Time where + +import qualified Hydra.Core as Core +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Time as Time +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | Encoder for hydra.time.Timespec +timespec :: Time.Timespec -> Core.Term +timespec x = + Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.time.Timespec"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "seconds"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 x2))) (Time.timespecSeconds x))}, + Core.Field { + Core.fieldName = (Core.Name "nanoseconds"), + Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 x2))) (Time.timespecNanoseconds x))}]}) diff --git a/src/main/haskell/Hydra/Encode/Topology.hs b/src/main/haskell/Hydra/Encode/Topology.hs --- a/src/main/haskell/Hydra/Encode/Topology.hs +++ b/src/main/haskell/Hydra/Encode/Topology.hs @@ -1,19 +1,23 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.topology module Hydra.Encode.Topology where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Topology as Topology import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Encoder for hydra.topology.Graph graph :: M.Map Topology.Vertex [Topology.Vertex] -> Core.Term graph m = Core.TermMap (Maps.bimap vertex (\xs -> Core.TermList (Lists.map vertex xs)) m) + -- | Encoder for hydra.topology.TarjanState tarjanState :: Topology.TarjanState -> Core.Term tarjanState x = @@ -38,6 +42,7 @@ Core.Field { Core.fieldName = (Core.Name "sccs"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map (\xs2 -> Core.TermList (Lists.map vertex xs2)) xs)) (Topology.tarjanStateSccs x))}]}) + -- | Encoder for hydra.topology.Vertex vertex :: Int -> Core.Term vertex x = Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x)) 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 @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.typed module Hydra.Encode.Typed where + import qualified Hydra.Core as Core 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 + -- | Encoder for hydra.typed.TypedBinding typedBinding :: (a -> Core.Term) -> Typed.TypedBinding a -> Core.Term typedBinding a x = @@ -19,12 +22,14 @@ Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = (typedTerm a (Typed.typedBindingTerm x))}]}) + -- | Encoder for hydra.typed.TypedTerm typedTerm :: (a -> Core.Term) -> Typed.TypedTerm a -> Core.Term typedTerm a x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.typed.TypedTerm"), Core.wrappedTermBody = (EncodeCore.term (Typed.unTypedTerm x))}) + -- | Encoder for hydra.typed.TypedTermDefinition typedTermDefinition :: (a -> Core.Term) -> Typed.TypedTermDefinition a -> Core.Term typedTermDefinition a x = diff --git a/src/main/haskell/Hydra/Encode/Typing.hs b/src/main/haskell/Hydra/Encode/Typing.hs --- a/src/main/haskell/Hydra/Encode/Typing.hs +++ b/src/main/haskell/Hydra/Encode/Typing.hs @@ -1,16 +1,19 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.typing module Hydra.Encode.Typing where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Paths as Paths -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals +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.Typing as Typing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.typing.FunctionStructure functionStructure :: (env -> Core.Term) -> Typing.FunctionStructure env -> Core.Term functionStructure env x = @@ -38,6 +41,7 @@ Core.Field { Core.fieldName = (Core.Name "environment"), Core.fieldTerm = (env (Typing.functionStructureEnvironment x))}]}) + -- | Encoder for hydra.typing.InferenceContext inferenceContext :: Typing.InferenceContext -> Core.Term inferenceContext x = @@ -50,6 +54,7 @@ Core.Field { Core.fieldName = (Core.Name "trace"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map Paths.subtermStep xs)) (Typing.inferenceContextTrace x))}]}) + -- | Encoder for hydra.typing.InferenceResult inferenceResult :: Typing.InferenceResult -> Core.Term inferenceResult x = @@ -71,6 +76,7 @@ Core.Field { Core.fieldName = (Core.Name "context"), Core.fieldTerm = (inferenceContext (Typing.inferenceResultContext x))}]}) + -- | Encoder for hydra.typing.Parameter parameter :: Typing.Parameter -> Core.Term parameter x = @@ -89,6 +95,7 @@ Core.Field { Core.fieldName = (Core.Name "isLazy"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralBoolean x2)) (Typing.parameterIsLazy x))}]}) + -- | Encoder for hydra.typing.Result result :: Typing.Result -> Core.Term result x = @@ -101,6 +108,7 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (EncodeCore.type_ (Typing.resultType x))}]}) + -- | Encoder for hydra.typing.TermSignature termSignature :: Typing.TermSignature -> Core.Term termSignature x = @@ -116,12 +124,14 @@ Core.Field { Core.fieldName = (Core.Name "result"), Core.fieldTerm = (result (Typing.termSignatureResult x))}]}) + -- | Encoder for hydra.typing.TermSubst termSubst :: Typing.TermSubst -> Core.Term termSubst x = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.typing.TermSubst"), Core.wrappedTermBody = ((\m -> Core.TermMap (Maps.bimap EncodeCore.name EncodeCore.term m)) (Typing.unTermSubst x))}) + -- | Encoder for hydra.typing.TypeClass typeClass :: Typing.TypeClass -> Core.Term typeClass x = @@ -131,6 +141,7 @@ Core.Field { Core.fieldName = (Core.Name "description"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Typing.typeClassDescription x))}]}) + -- | Encoder for hydra.typing.TypeConstraint typeConstraint :: Typing.TypeConstraint -> Core.Term typeConstraint x = @@ -146,6 +157,7 @@ Core.Field { Core.fieldName = (Core.Name "comment"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Typing.typeConstraintComment x))}]}) + -- | Encoder for hydra.typing.TypeParameter typeParameter :: Typing.TypeParameter -> Core.Term typeParameter x = @@ -158,6 +170,7 @@ Core.Field { Core.fieldName = (Core.Name "constraints"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.typeClassConstraint xs)) (Typing.typeParameterConstraints x))}]}) + -- | Encoder for hydra.typing.TypeSubst typeSubst :: Typing.TypeSubst -> Core.Term typeSubst x = diff --git a/src/main/haskell/Hydra/Encode/Util.hs b/src/main/haskell/Hydra/Encode/Util.hs --- a/src/main/haskell/Hydra/Encode/Util.hs +++ b/src/main/haskell/Hydra/Encode/Util.hs @@ -1,16 +1,19 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.util module Hydra.Encode.Util where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Packaging as Packaging -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs +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.Util as Util import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.util.CaseConvention caseConvention :: Util.CaseConvention -> Core.Term caseConvention x = @@ -35,6 +38,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "upperSnake"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.util.Comparison comparison :: Util.Comparison -> Core.Term comparison x = @@ -54,12 +58,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "greaterThan"), Core.fieldTerm = Core.TermUnit}}) --- | Encoder for hydra.util.FileExtension -fileExtension :: Util.FileExtension -> Core.Term -fileExtension x = - Core.TermWrap (Core.WrappedTerm { - Core.wrappedTermTypeName = (Core.Name "hydra.util.FileExtension"), - Core.wrappedTermBody = ((\x2 -> Core.TermLiteral (Core.LiteralString x2)) (Util.unFileExtension x))}) + -- | Encoder for hydra.util.ModuleNames moduleNames :: (n -> Core.Term) -> Util.ModuleNames n -> Core.Term moduleNames n x = @@ -72,6 +71,7 @@ Core.Field { Core.fieldName = (Core.Name "mapping"), Core.fieldTerm = ((\m -> Core.TermMap (Maps.bimap Packaging.moduleName n m)) (Util.moduleNamesMapping x))}]}) + -- | Encoder for hydra.util.Precision precision :: Util.Precision -> Core.Term precision x = @@ -86,6 +86,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "bits"), Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v0)))}}) + -- | Encoder for hydra.util.QualifiedName qualifiedName :: Util.QualifiedName -> Core.Term qualifiedName x = diff --git a/src/main/haskell/Hydra/Encode/Validation.hs b/src/main/haskell/Hydra/Encode/Validation.hs --- a/src/main/haskell/Hydra/Encode/Validation.hs +++ b/src/main/haskell/Hydra/Encode/Validation.hs @@ -1,15 +1,18 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.validation module Hydra.Encode.Validation where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Encode.Error.Core as ErrorCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets import qualified Hydra.Validation as Validation import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.validation.ValidationProfile validationProfile :: Validation.ValidationProfile -> Core.Term validationProfile x = @@ -28,6 +31,7 @@ Core.Field { Core.fieldName = (Core.Name "maxWarnings"), Core.fieldTerm = ((\x2 -> Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 x2))) (Validation.validationProfileMaxWarnings x))}]}) + -- | Encoder for hydra.validation.ValidationResult validationResult :: (e -> Core.Term) -> Validation.ValidationResult e -> Core.Term validationResult e x = diff --git a/src/main/haskell/Hydra/Encode/Variants.hs b/src/main/haskell/Hydra/Encode/Variants.hs --- a/src/main/haskell/Hydra/Encode/Variants.hs +++ b/src/main/haskell/Hydra/Encode/Variants.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.variants module Hydra.Encode.Variants where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.variants.LiteralVariant literalVariant :: Variants.LiteralVariant -> Core.Term literalVariant x = @@ -41,6 +44,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "string"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.variants.TermVariant termVariant :: Variants.TermVariant -> Core.Term termVariant x = @@ -150,6 +154,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), Core.fieldTerm = Core.TermUnit}}) + -- | Encoder for hydra.variants.TypeVariant typeVariant :: Variants.TypeVariant -> Core.Term typeVariant x = @@ -163,6 +168,11 @@ Core.injectionTypeName = (Core.Name "hydra.variants.TypeVariant"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), + Core.fieldTerm = Core.TermUnit}}) + Variants.TypeVariantEffect -> Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.variants.TypeVariant"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "effect"), Core.fieldTerm = Core.TermUnit}}) Variants.TypeVariantEither -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.variants.TypeVariant"), diff --git a/src/main/haskell/Hydra/Encode/Yaml/Model.hs b/src/main/haskell/Hydra/Encode/Yaml/Model.hs --- a/src/main/haskell/Hydra/Encode/Yaml/Model.hs +++ b/src/main/haskell/Hydra/Encode/Yaml/Model.hs @@ -1,14 +1,17 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Term encoders for hydra.yaml.model module Hydra.Encode.Yaml.Model where + import qualified Hydra.Core as Core import qualified Hydra.Encode.Core as EncodeCore -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Yaml.Model as Model import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Encoder for hydra.yaml.model.Node node :: Model.Node -> Core.Term node x = @@ -28,6 +31,7 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "sequence"), Core.fieldTerm = (Core.TermList (Lists.map node v0))}}) + -- | Encoder for hydra.yaml.model.Scalar scalar :: Model.Scalar -> Core.Term scalar 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 @@ -1,28 +1,34 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for generating term encoders from type modules module Hydra.Encoding 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.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -32,8 +38,10 @@ 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 @@ -42,6 +50,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Transform a type binding into an encoder binding encodeBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.DecodingError Core.Binding encodeBinding cx graph b = @@ -55,6 +64,7 @@ Core.bindingName = (encodeBindingName (Core.bindingName b)), Core.bindingTerm = (Annotations.setTermDescription (Just description) rawBody), Core.bindingTypeScheme = (Just (encoderTypeSchemeNamed (Core.bindingName b) typ))}))) + -- | Generate a binding name for an encoder function from a type name encodeBindingName :: Core.Name -> Core.Name encodeBindingName n = @@ -68,6 +78,7 @@ "hydra", "encode"] (Lists.concat2 tail [ localPart]))))))) + -- | Generate an encoder for an Either type encodeEitherType :: Core.EitherType -> Core.Term encodeEitherType et = @@ -95,6 +106,7 @@ Core.applicationArgument = (encodeType (Core.eitherTypeLeft et))})), Core.applicationArgument = (encodeType (Core.eitherTypeRight et))})), Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}}))}) + -- | Generate the encoder for a field's value encodeFieldValue :: Core.Name -> Core.Name -> Core.Type -> Core.Term encodeFieldValue typeName fieldName fieldType = @@ -108,6 +120,7 @@ Core.fieldTerm = (encodeInjection typeName fieldName (Core.TermApplication (Core.Application { Core.applicationFunction = (encodeType fieldType), Core.applicationArgument = (Core.TermVariable (Core.Name "y"))})))}}))}) + -- | Encode a float value based on its float type encodeFloatValue :: Core.FloatType -> Core.Term -> Core.Term encodeFloatValue floatType valTerm = @@ -118,6 +131,7 @@ Core.FloatTypeFloat32 -> Core.Name "float32" Core.FloatTypeFloat64 -> Core.Name "float64", Core.fieldTerm = valTerm}}) + -- | Generate an encoder for a polymorphic (forall) type encodeForallType :: Core.ForallType -> Core.Term encodeForallType ft = @@ -127,6 +141,7 @@ Core.functionTypeDomain = (Core.TypeVariable (Core.forallTypeParameter ft)), Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))), Core.lambdaBody = (encodeType (Core.forallTypeBody ft))}) + -- | Encode an Injection as a term encodeInjection :: Core.Name -> Core.Name -> Core.Term -> Core.Term encodeInjection typeName fieldName fieldTerm = @@ -147,6 +162,7 @@ Core.Field { Core.fieldName = (Core.Name "term"), Core.fieldTerm = fterm}]})) fieldName fieldTerm)}]}) + -- | Encode an integer value based on its integer type encodeIntegerValue :: Core.IntegerType -> Core.Term -> Core.Term encodeIntegerValue intType valTerm = @@ -164,6 +180,7 @@ Core.IntegerTypeUint32 -> Core.Name "uint32" Core.IntegerTypeUint64 -> Core.Name "uint64", Core.fieldTerm = valTerm}}) + -- | Generate an encoder for a list type encodeListType :: Core.Type -> Core.Term encodeListType elemType = @@ -183,6 +200,7 @@ Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), Core.applicationArgument = (encodeType elemType)})), Core.applicationArgument = (Core.TermVariable (Core.Name "xs"))}))}}))}) + -- | Generate an encoder for a literal type encodeLiteralType :: Core.LiteralType -> Core.Term encodeLiteralType x = @@ -263,6 +281,7 @@ Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}) + -- | Generate an encoder for a map type encodeMapType :: Core.MapType -> Core.Term encodeMapType mt = @@ -290,6 +309,7 @@ Core.applicationArgument = (encodeType (Core.mapTypeKeys mt))})), Core.applicationArgument = (encodeType (Core.mapTypeValues mt))})), Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}}))}) + -- | Transform a type module into an encoder module encodeModule :: t0 -> Graph.Graph -> Packaging.Module -> Either Errors.Error (Maybe Packaging.Module) encodeModule cx graph mod = @@ -326,6 +346,7 @@ Packaging.termDefinitionMetadata = Nothing, Packaging.termDefinitionSignature = (Optionals.map Scoping.typeSchemeToTermSignature (Core.bindingTypeScheme b)), Packaging.termDefinitionBody = (Core.bindingTerm b)})) encodedBindings)}))))) + -- | Generate an encoder module name from a source module name encodeModuleName :: Packaging.ModuleName -> Packaging.ModuleName encodeModuleName ns = @@ -335,12 +356,14 @@ in (Optionals.cases (Lists.uncons parts) fallback (\uc -> Packaging.ModuleName (Strings.cat [ "hydra.encode.", (Strings.intercalate "." (Pairs.second uc))]))) + -- | Encode a Name as a term encodeName :: Core.Name -> Core.Term encodeName n = Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"), Core.wrappedTermBody = (Core.TermLiteral (Core.LiteralString (Core.unName n)))}) + -- | Generate an encoder for a Maybe type encodeOptionalType :: Core.Type -> Core.Term encodeOptionalType elemType = @@ -360,6 +383,7 @@ Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), Core.applicationArgument = (encodeType elemType)})), Core.applicationArgument = (Core.TermVariable (Core.Name "opt"))}))}}))}) + -- | Generate an encoder for a pair type encodePairType :: Core.PairType -> Core.Term encodePairType pt = @@ -387,9 +411,11 @@ Core.applicationArgument = (encodeType (Core.pairTypeFirst pt))})), Core.applicationArgument = (encodeType (Core.pairTypeSecond pt))})), Core.applicationArgument = (Core.TermVariable (Core.Name "p"))}))}}))}) + -- | Generate an encoder for a record type (unnamed — should not be called directly) encodeRecordType :: [Core.FieldType] -> Core.Term encodeRecordType rt = encodeRecordTypeNamed (Core.Name "unknown") rt + -- | Generate an encoder for a record type with the given element name encodeRecordTypeNamed :: Core.Name -> [Core.FieldType] -> Core.Term encodeRecordTypeNamed ename rt = @@ -423,6 +449,7 @@ Core.projectionTypeName = tname, Core.projectionFieldName = (Core.fieldTypeName ft)})), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}]})) ename rt) rt))}]}))}}))}) + -- | Generate an encoder for a set type encodeSetType :: Core.Type -> Core.Term encodeSetType elemType = @@ -442,6 +469,7 @@ Core.typeApplicationTermType = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), Core.applicationArgument = (encodeType elemType)})), Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}}))}) + -- | Generate an encoder term for a Type encodeType :: Core.Type -> Core.Term encodeType x = @@ -486,6 +514,7 @@ Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}) + -- | Generate an encoder term for a Type, with the element name for nominal types encodeTypeNamed :: Core.Name -> Core.Type -> Core.Term encodeTypeNamed ename typ = @@ -535,9 +564,11 @@ Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}) + -- | Generate an encoder for a union type (placeholder name) encodeUnionType :: [Core.FieldType] -> Core.Term encodeUnionType rt = encodeUnionTypeNamed (Core.Name "unknown") rt + -- | Generate an encoder for a union type with the given element name encodeUnionTypeNamed :: Core.Name -> [Core.FieldType] -> Core.Term encodeUnionTypeNamed ename rt = @@ -547,9 +578,11 @@ Core.caseStatementCases = (Lists.map (\ft -> Core.CaseAlternative { Core.caseAlternativeName = (Core.fieldTypeName ft), Core.caseAlternativeHandler = (encodeFieldValue ename (Core.fieldTypeName ft) (Core.fieldTypeType ft))}) rt)}) + -- | Generate an encoder for a wrapped type (placeholder name) encodeWrappedType :: Core.Type -> Core.Term encodeWrappedType wt = encodeWrappedTypeNamed (Core.Name "unknown") wt + -- | Generate an encoder for a wrapped type with the given element name encodeWrappedTypeNamed :: Core.Name -> Core.Type -> Core.Term encodeWrappedTypeNamed ename wt = @@ -573,6 +606,7 @@ Core.applicationArgument = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermUnwrap ename), Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}]}))}}))}) + -- | Collect forall type variable names from a type encoderCollectForallVariables :: Core.Type -> [Core.Name] encoderCollectForallVariables typ = @@ -580,12 +614,14 @@ Core.TypeAnnotated v0 -> encoderCollectForallVariables (Core.annotatedTypeBody v0) Core.TypeForall v0 -> Lists.cons (Core.forallTypeParameter v0) (encoderCollectForallVariables (Core.forallTypeBody v0)) _ -> [] + -- | Collect type variables needing Ord constraints encoderCollectOrdVars :: Core.Type -> [Core.Name] encoderCollectOrdVars typ = case typ of Core.TypeAnnotated v0 -> encoderCollectOrdVars (Core.annotatedTypeBody v0) Core.TypeApplication v0 -> Lists.concat2 (encoderCollectOrdVars (Core.applicationTypeFunction v0)) (encoderCollectOrdVars (Core.applicationTypeArgument v0)) + Core.TypeEffect v0 -> encoderCollectOrdVars v0 Core.TypeEither v0 -> Lists.concat2 (encoderCollectOrdVars (Core.eitherTypeLeft v0)) (encoderCollectOrdVars (Core.eitherTypeRight v0)) Core.TypeForall v0 -> encoderCollectOrdVars (Core.forallTypeBody v0) Core.TypeList v0 -> encoderCollectOrdVars v0 @@ -600,12 +636,14 @@ Core.TypeUnion v0 -> Lists.concat (Lists.map (\ft -> encoderCollectOrdVars (Core.fieldTypeType ft)) v0) Core.TypeWrap v0 -> encoderCollectOrdVars v0 _ -> [] + -- | Collect all type variable names from a type expression encoderCollectTypeVarsFromType :: Core.Type -> [Core.Name] encoderCollectTypeVarsFromType typ = case typ of Core.TypeAnnotated v0 -> encoderCollectTypeVarsFromType (Core.annotatedTypeBody v0) Core.TypeApplication v0 -> Lists.concat2 (encoderCollectTypeVarsFromType (Core.applicationTypeFunction v0)) (encoderCollectTypeVarsFromType (Core.applicationTypeArgument v0)) + Core.TypeEffect v0 -> encoderCollectTypeVarsFromType v0 Core.TypeForall v0 -> encoderCollectTypeVarsFromType (Core.forallTypeBody v0) Core.TypeList v0 -> encoderCollectTypeVarsFromType v0 Core.TypeMap v0 -> Lists.concat2 (encoderCollectTypeVarsFromType (Core.mapTypeKeys v0)) (encoderCollectTypeVarsFromType (Core.mapTypeValues v0)) @@ -618,6 +656,7 @@ v0] Core.TypeWrap v0 -> encoderCollectTypeVarsFromType v0 _ -> [] + -- | Get full result type for encoder input encoderFullResultType :: Core.Type -> Core.Type encoderFullResultType typ = @@ -626,6 +665,7 @@ Core.TypeApplication v0 -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (encoderFullResultType (Core.applicationTypeFunction v0)), Core.applicationTypeArgument = (Core.applicationTypeArgument v0)}) + Core.TypeEffect v0 -> Core.TypeEffect (encoderFullResultType v0) Core.TypeEither v0 -> Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (encoderFullResultType (Core.eitherTypeLeft v0)), Core.eitherTypeRight = (encoderFullResultType (Core.eitherTypeRight v0))}) @@ -649,6 +689,7 @@ Core.TypeVoid -> Core.TypeVoid Core.TypeWrap v0 -> encoderFullResultType v0 _ -> Core.TypeVariable (Core.Name "hydra.core.Term") + -- | Get full result type for encoder input, using element name for nominal types encoderFullResultTypeNamed :: Core.Name -> Core.Type -> Core.Type encoderFullResultTypeNamed ename typ = @@ -657,6 +698,7 @@ Core.TypeApplication v0 -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (encoderFullResultType (Core.applicationTypeFunction v0)), Core.applicationTypeArgument = (Core.applicationTypeArgument v0)}) + Core.TypeEffect v0 -> Core.TypeEffect (encoderFullResultType v0) Core.TypeEither v0 -> Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (encoderFullResultType (Core.eitherTypeLeft v0)), Core.eitherTypeRight = (encoderFullResultType (Core.eitherTypeRight v0))}) @@ -680,6 +722,7 @@ Core.TypeVoid -> Core.TypeVoid Core.TypeWrap _ -> Core.TypeVariable ename _ -> Core.TypeVariable (Core.Name "hydra.core.Term") + -- | Build encoder function type encoderType :: Core.Type -> Core.Type encoderType typ = @@ -690,6 +733,7 @@ Core.functionTypeDomain = resultType, Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))}) in (prependForallEncoders baseType typ) + -- | Build encoder function type with element name for nominal types encoderTypeNamed :: Core.Name -> Core.Type -> Core.Type encoderTypeNamed ename typ = @@ -700,6 +744,7 @@ Core.functionTypeDomain = resultType, Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "hydra.core.Term"))}) in (prependForallEncoders baseType typ) + -- | Construct a TypeScheme for an encoder function from a source type encoderTypeScheme :: Core.Type -> Core.TypeScheme encoderTypeScheme typ = @@ -718,6 +763,7 @@ Core.typeSchemeVariables = typeVars, Core.typeSchemeBody = encoderFunType, Core.typeSchemeConstraints = constraints} + -- | Construct a TypeScheme for an encoder function, with element name for nominal types encoderTypeSchemeNamed :: Core.Name -> Core.Type -> Core.TypeScheme encoderTypeSchemeNamed ename typ = @@ -736,20 +782,24 @@ Core.typeSchemeVariables = typeVars, Core.typeSchemeBody = encoderFunType, Core.typeSchemeConstraints = constraints} + -- | 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)) + -- | Check if a binding is encodable (serializable type) isEncodableBinding :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error (Maybe Core.Binding) isEncodableBinding cx graph b = Eithers.bind (Predicates.isSerializableByName cx graph (Core.bindingName b)) (\serializable -> Right (Logic.ifElse serializable (Just b) Nothing)) + -- | Check whether a type is the unit type isUnitType :: Core.Type -> Bool isUnitType x = case x of Core.TypeUnit -> True _ -> False + -- | Prepend encoder types for forall parameters to base type prependForallEncoders :: Core.Type -> Core.Type -> Core.Type prependForallEncoders baseType typ = 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 @@ -1,27 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Graph to type environment conversions module Hydra.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.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths @@ -30,8 +36,10 @@ 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 @@ -42,6 +50,7 @@ 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 definition to a typed term definitionAsTypeApplicationTerm :: Core.Binding -> Either Errors.Error Core.TypeApplicationTerm definitionAsTypeApplicationTerm el = @@ -50,21 +59,25 @@ Errors.unexpectedShapeErrorActual = "untyped binding"})))) (\ts -> Right (Core.TypeApplicationTerm { Core.typeApplicationTermBody = (Core.bindingTerm el), Core.typeApplicationTermType = (Core.typeSchemeBody ts)})) + -- | Convert bindings and a body to a let expression graphAsLet :: [Core.Binding] -> Core.Term -> Core.Let graphAsLet bindings body = Core.Let { Core.letBindings = bindings, Core.letBody = body} + -- | Convert bindings and a body to a term, using let-term duality graphAsTerm :: [Core.Binding] -> Core.Term -> Core.Term graphAsTerm bindings body = Core.TermLet (graphAsLet bindings body) + -- | Decode a list of type-encoding bindings into a map of named types graphAsTypes :: Graph.Graph -> [Core.Binding] -> Either Errors.DecodingError (M.Map Core.Name Core.Type) graphAsTypes graph els = let toPair = \el -> Eithers.map (\typ -> (Core.bindingName el, typ)) (DecodeCore.type_ graph (Core.bindingTerm el)) in (Eithers.map Maps.fromList (Eithers.mapList toPair els)) + -- | Partition a list of definitions into type definitions and term definitions partitionDefinitions :: [Packaging.Definition] -> ([Packaging.TypeDefinition], [Packaging.TermDefinition]) partitionDefinitions defs = @@ -80,6 +93,7 @@ Packaging.DefinitionTerm v0 -> Just v0 Packaging.DefinitionPrimitive _ -> Nothing in (Optionals.cat (Lists.map getType defs), (Optionals.cat (Lists.map getTerm defs))) + -- | Reorder definitions: types first (with hydra.core.Name first among types), then topologically sorted terms reorderDefs :: [Packaging.Definition] -> [Packaging.Definition] reorderDefs defs = @@ -103,6 +117,7 @@ in (Lists.concat [ typeDefs, sortedTermDefs]) + -- | Convert a schema graph to a typing environment (Either version) schemaGraphToTypingEnvironment :: Graph.Graph -> Either Errors.Error (M.Map Core.Name Core.TypeScheme) schemaGraphToTypingEnvironment g = @@ -131,12 +146,14 @@ 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))) + -- | Extract the bindings from a let term, or return an empty list for other terms termAsBindings :: Core.Term -> [Core.Binding] termAsBindings term = case (Strip.deannotateTerm term) of Core.TermLet v0 -> Core.letBindings v0 _ -> [] + -- | Encode a map of named types to a list of bindings typesToDefinitions :: M.Map Core.Name Core.Type -> [Core.Binding] typesToDefinitions typeMap = @@ -149,18 +166,21 @@ Core.bindingTerm = (EncodeCore.type_ (Pairs.second pair)), Core.bindingTypeScheme = Nothing} in (Lists.map toElement (Maps.toList typeMap)) + -- | Execute a computation in the context of a lambda body, extending the type context with the lambda parameter withLambdaContext :: (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t1) -> t0 -> Core.Lambda -> (t1 -> t2) -> t2 withLambdaContext getContext setContext env lam body = let newContext = Scoping.extendGraphForLambda (getContext env) lam in (body (setContext newContext env)) + -- | Execute a computation in the context of a let body, extending the type context with the let bindings withLetContext :: (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t1) -> (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> t0 -> Core.Let -> (t1 -> t2) -> t2 withLetContext getContext setContext forBinding env letrec body = let newContext = Scoping.extendGraphForLet forBinding (getContext env) letrec in (body (setContext newContext env)) + -- | Execute a computation in the context of a type lambda body, extending the type context with the type parameter withTypeLambdaContext :: (t0 -> Graph.Graph) -> (Graph.Graph -> t0 -> t1) -> t0 -> Core.TypeLambda -> (t1 -> t2) -> t2 withTypeLambdaContext getContext setContext env tlam body = diff --git a/src/main/haskell/Hydra/Error/Checking.hs b/src/main/haskell/Hydra/Error/Checking.hs --- a/src/main/haskell/Hydra/Error/Checking.hs +++ b/src/main/haskell/Hydra/Error/Checking.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Error types for type checking module Hydra.Error.Checking where + import qualified Hydra.Core as Core import qualified Hydra.Paths as Paths import qualified Hydra.Typing as Typing @@ -9,6 +11,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | An error that occurred during type checking data CheckingError = -- | A post-unification consistency check failure @@ -38,28 +41,46 @@ -- | A reference to a term variable whose type is not known, encountered during checking CheckingErrorUntypedTermVariable UntypedTermVariableCheckingError deriving (Eq, Ord, Read, Show) + _CheckingError = Core.Name "hydra.error.checking.CheckingError" + _CheckingError_incorrectUnification = Core.Name "incorrectUnification" + _CheckingError_notAForallType = Core.Name "notAForallType" + _CheckingError_notAFunctionType = Core.Name "notAFunctionType" + _CheckingError_other = Core.Name "other" + _CheckingError_typeArityMismatch = Core.Name "typeArityMismatch" + _CheckingError_typeMismatch = Core.Name "typeMismatch" + _CheckingError_unboundTypeVariables = Core.Name "unboundTypeVariables" + _CheckingError_undefinedTermVariable = Core.Name "undefinedTermVariable" + _CheckingError_unequalTypes = Core.Name "unequalTypes" + _CheckingError_unsupportedTermVariant = Core.Name "unsupportedTermVariant" + _CheckingError_untypedLambda = Core.Name "untypedLambda" + _CheckingError_untypedLetBinding = Core.Name "untypedLetBinding" + _CheckingError_untypedTermVariable = Core.Name "untypedTermVariable" + -- | A post-unification consistency check failure data IncorrectUnificationError = IncorrectUnificationError { -- | The substitution that failed the consistency check incorrectUnificationErrorSubstitution :: Typing.TypeSubst} deriving (Eq, Ord, Read, Show) + _IncorrectUnificationError = Core.Name "hydra.error.checking.IncorrectUnificationError" + _IncorrectUnificationError_substitution = Core.Name "substitution" + -- | A type that is not a forall type when type arguments are being applied data NotAForallTypeError = NotAForallTypeError { @@ -68,17 +89,24 @@ -- | The type arguments that were being applied notAForallTypeErrorTypeArguments :: [Core.Type]} deriving (Eq, Ord, Read, Show) + _NotAForallTypeError = Core.Name "hydra.error.checking.NotAForallTypeError" + _NotAForallTypeError_type = Core.Name "type" + _NotAForallTypeError_typeArguments = Core.Name "typeArguments" + -- | A type that is not a function type when one was expected in an application data NotAFunctionTypeError = NotAFunctionTypeError { -- | The actual type encountered notAFunctionTypeErrorType :: Core.Type} deriving (Eq, Ord, Read, Show) + _NotAFunctionTypeError = Core.Name "hydra.error.checking.NotAFunctionTypeError" + _NotAFunctionTypeError_type = Core.Name "type" + -- | A generic checking error: message + subterm path data OtherCheckingError = OtherCheckingError { @@ -87,9 +115,13 @@ -- | A human-readable error message otherCheckingErrorMessage :: String} deriving (Eq, Ord, Read, Show) + _OtherCheckingError = Core.Name "hydra.error.checking.OtherCheckingError" + _OtherCheckingError_path = Core.Name "path" + _OtherCheckingError_message = Core.Name "message" + -- | A type constructor applied to the wrong number of type arguments data TypeArityMismatchError = TypeArityMismatchError { @@ -102,11 +134,17 @@ -- | The type arguments that were provided typeArityMismatchErrorTypeArguments :: [Core.Type]} deriving (Eq, Ord, Read, Show) + _TypeArityMismatchError = Core.Name "hydra.error.checking.TypeArityMismatchError" + _TypeArityMismatchError_type = Core.Name "type" + _TypeArityMismatchError_expectedArity = Core.Name "expectedArity" + _TypeArityMismatchError_actualArity = Core.Name "actualArity" + _TypeArityMismatchError_typeArguments = Core.Name "typeArguments" + -- | A type mismatch between expected and actual types data TypeMismatchError = TypeMismatchError { @@ -115,9 +153,13 @@ -- | The actual type encountered typeMismatchErrorActualType :: Core.Type} deriving (Eq, Ord, Read, Show) + _TypeMismatchError = Core.Name "hydra.error.checking.TypeMismatchError" + _TypeMismatchError_expectedType = Core.Name "expectedType" + _TypeMismatchError_actualType = Core.Name "actualType" + -- | Type variables that appear free in a type but are not bound in scope data UnboundTypeVariablesError = UnboundTypeVariablesError { @@ -126,9 +168,13 @@ -- | The type containing the unbound variables unboundTypeVariablesErrorType :: Core.Type} deriving (Eq, Ord, Read, Show) + _UnboundTypeVariablesError = Core.Name "hydra.error.checking.UnboundTypeVariablesError" + _UnboundTypeVariablesError_variables = Core.Name "variables" + _UnboundTypeVariablesError_type = Core.Name "type" + -- | A reference to a term variable that is not bound in scope, encountered during checking data UndefinedTermVariableCheckingError = UndefinedTermVariableCheckingError { @@ -137,9 +183,13 @@ -- | The name of the undefined variable undefinedTermVariableCheckingErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTermVariableCheckingError = Core.Name "hydra.error.checking.UndefinedTermVariableCheckingError" + _UndefinedTermVariableCheckingError_path = Core.Name "path" + _UndefinedTermVariableCheckingError_name = Core.Name "name" + -- | Multiple types that should all be equal but are not data UnequalTypesError = UnequalTypesError { @@ -148,30 +198,42 @@ -- | A description of the context in which the types were expected to be equal unequalTypesErrorDescription :: String} deriving (Eq, Ord, Read, Show) + _UnequalTypesError = Core.Name "hydra.error.checking.UnequalTypesError" + _UnequalTypesError_types = Core.Name "types" + _UnequalTypesError_description = Core.Name "description" + -- | A term variant that the type checker does not support data UnsupportedTermVariantError = UnsupportedTermVariantError { -- | The unsupported term variant unsupportedTermVariantErrorTermVariant :: Variants.TermVariant} deriving (Eq, Ord, Read, Show) + _UnsupportedTermVariantError = Core.Name "hydra.error.checking.UnsupportedTermVariantError" + _UnsupportedTermVariantError_termVariant = Core.Name "termVariant" + -- | A lambda expression without a type annotation on its parameter data UntypedLambdaError = UntypedLambdaError {} deriving (Eq, Ord, Read, Show) + _UntypedLambdaError = Core.Name "hydra.error.checking.UntypedLambdaError" + -- | A let binding without a type annotation data UntypedLetBindingError = UntypedLetBindingError { -- | The untyped binding untypedLetBindingErrorBinding :: Core.Binding} deriving (Eq, Ord, Read, Show) + _UntypedLetBindingError = Core.Name "hydra.error.checking.UntypedLetBindingError" + _UntypedLetBindingError_binding = Core.Name "binding" + -- | A reference to a term variable whose type is not known, encountered during checking data UntypedTermVariableCheckingError = UntypedTermVariableCheckingError { @@ -180,6 +242,9 @@ -- | The name of the untyped variable untypedTermVariableCheckingErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UntypedTermVariableCheckingError = Core.Name "hydra.error.checking.UntypedTermVariableCheckingError" + _UntypedTermVariableCheckingError_path = Core.Name "path" + _UntypedTermVariableCheckingError_name = Core.Name "name" 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 @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Error types for core type and term validation module Hydra.Error.Core where + import qualified Hydra.Core as Core import qualified Hydra.Paths as Paths import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | An application of ifElse where the condition is a literal boolean, creating a dead branch (optional) data ConstantConditionError = ConstantConditionError { @@ -15,9 +18,13 @@ -- | The constant boolean value of the condition constantConditionErrorValue :: Bool} deriving (Eq, Ord, Read, Show) + _ConstantConditionError = Core.Name "hydra.error.core.ConstantConditionError" + _ConstantConditionError_location = Core.Name "location" + _ConstantConditionError_value = Core.Name "value" + -- | A duplicate binding name in a let expression data DuplicateBindingError = DuplicateBindingError { @@ -26,9 +33,13 @@ -- | The duplicated binding name duplicateBindingErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DuplicateBindingError = Core.Name "hydra.error.core.DuplicateBindingError" + _DuplicateBindingError_location = Core.Name "location" + _DuplicateBindingError_name = Core.Name "name" + -- | A duplicate field name in a record or union type data DuplicateFieldError = DuplicateFieldError { @@ -37,9 +48,13 @@ -- | The duplicated field name duplicateFieldErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DuplicateFieldError = Core.Name "hydra.error.core.DuplicateFieldError" + _DuplicateFieldError_location = Core.Name "location" + _DuplicateFieldError_name = Core.Name "name" + -- | A record type with duplicate field names data DuplicateRecordTypeFieldNamesError = DuplicateRecordTypeFieldNamesError { @@ -48,9 +63,13 @@ -- | The duplicated field name duplicateRecordTypeFieldNamesErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DuplicateRecordTypeFieldNamesError = Core.Name "hydra.error.core.DuplicateRecordTypeFieldNamesError" + _DuplicateRecordTypeFieldNamesError_location = Core.Name "location" + _DuplicateRecordTypeFieldNamesError_name = Core.Name "name" + -- | A union type with duplicate field names data DuplicateUnionTypeFieldNamesError = DuplicateUnionTypeFieldNamesError { @@ -59,9 +78,13 @@ -- | The duplicated field name duplicateUnionTypeFieldNamesErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DuplicateUnionTypeFieldNamesError = Core.Name "hydra.error.core.DuplicateUnionTypeFieldNamesError" + _DuplicateUnionTypeFieldNamesError_location = Core.Name "location" + _DuplicateUnionTypeFieldNamesError_name = Core.Name "name" + -- | A case statement with no cases and no default (optional) data EmptyCaseStatementError = EmptyCaseStatementError { @@ -70,57 +93,79 @@ -- | The name of the union type being matched emptyCaseStatementErrorTypeName :: Core.Name} deriving (Eq, Ord, Read, Show) + _EmptyCaseStatementError = Core.Name "hydra.error.core.EmptyCaseStatementError" + _EmptyCaseStatementError_location = Core.Name "location" + _EmptyCaseStatementError_typeName = Core.Name "typeName" + -- | A let expression with an empty list of bindings (optional) data EmptyLetBindingsError = EmptyLetBindingsError { -- | The path to the empty let expression within the term emptyLetBindingsErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyLetBindingsError = Core.Name "hydra.error.core.EmptyLetBindingsError" + _EmptyLetBindingsError_location = Core.Name "location" + -- | A record type with no fields; TypeUnit is preferred for the unit-like case (optional) data EmptyRecordTypeError = EmptyRecordTypeError { -- | The path to the empty record type emptyRecordTypeErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyRecordTypeError = Core.Name "hydra.error.core.EmptyRecordTypeError" + _EmptyRecordTypeError_location = Core.Name "location" + -- | A term annotation with an empty annotation map (optional) data EmptyTermAnnotationError = EmptyTermAnnotationError { -- | The path to the empty annotation within the term emptyTermAnnotationErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyTermAnnotationError = Core.Name "hydra.error.core.EmptyTermAnnotationError" + _EmptyTermAnnotationError_location = Core.Name "location" + -- | A type annotation with an empty annotation map (optional) data EmptyTypeAnnotationError = EmptyTypeAnnotationError { -- | The path to the empty annotation emptyTypeAnnotationErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyTypeAnnotationError = Core.Name "hydra.error.core.EmptyTypeAnnotationError" + _EmptyTypeAnnotationError_location = Core.Name "location" + -- | A record, injection, projection, or case statement with an empty type name (optional) data EmptyTypeNameInTermError = EmptyTypeNameInTermError { -- | The path to the term with the empty type name emptyTypeNameInTermErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyTypeNameInTermError = Core.Name "hydra.error.core.EmptyTypeNameInTermError" + _EmptyTypeNameInTermError_location = Core.Name "location" + -- | A union type with no alternatives; TypeVoid is preferred (optional) data EmptyUnionTypeError = EmptyUnionTypeError { -- | The path to the empty union type emptyUnionTypeErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _EmptyUnionTypeError = Core.Name "hydra.error.core.EmptyUnionTypeError" + _EmptyUnionTypeError_location = Core.Name "location" + -- | A forall type parameter name that violates type variable naming conventions (optional) data InvalidForallParameterNameError = InvalidForallParameterNameError { @@ -129,9 +174,13 @@ -- | The invalid parameter name invalidForallParameterNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _InvalidForallParameterNameError = Core.Name "hydra.error.core.InvalidForallParameterNameError" + _InvalidForallParameterNameError_location = Core.Name "location" + _InvalidForallParameterNameError_name = Core.Name "name" + -- | A lambda parameter name that violates naming conventions (optional) data InvalidLambdaParameterNameError = InvalidLambdaParameterNameError { @@ -140,9 +189,13 @@ -- | The invalid parameter name invalidLambdaParameterNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _InvalidLambdaParameterNameError = Core.Name "hydra.error.core.InvalidLambdaParameterNameError" + _InvalidLambdaParameterNameError_location = Core.Name "location" + _InvalidLambdaParameterNameError_name = Core.Name "name" + -- | A let binding name that violates naming conventions (optional) data InvalidLetBindingNameError = InvalidLetBindingNameError { @@ -151,16 +204,23 @@ -- | The invalid binding name invalidLetBindingNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _InvalidLetBindingNameError = Core.Name "hydra.error.core.InvalidLetBindingNameError" + _InvalidLetBindingNameError_location = Core.Name "location" + _InvalidLetBindingNameError_name = Core.Name "name" + -- | An error indicating that a literal value is invalid data InvalidLiteralError = -- | The literal's type does not match the expected literal type InvalidLiteralErrorTypeMismatch LiteralTypeMismatchError deriving (Eq, Ord, Read, Show) + _InvalidLiteralError = Core.Name "hydra.error.core.InvalidLiteralError" + _InvalidLiteralError_typeMismatch = Core.Name "typeMismatch" + -- | An error indicating that a term is invalid data InvalidTermError = -- | An ifElse with a literal boolean condition (optional) @@ -208,29 +268,53 @@ -- | A term variable whose type is not known InvalidTermErrorUntypedTermVariable UntypedTermVariableError deriving (Eq, Ord, Read, Show) + _InvalidTermError = Core.Name "hydra.error.core.InvalidTermError" + _InvalidTermError_constantCondition = Core.Name "constantCondition" + _InvalidTermError_duplicateBinding = Core.Name "duplicateBinding" + _InvalidTermError_duplicateField = Core.Name "duplicateField" + _InvalidTermError_emptyCaseStatement = Core.Name "emptyCaseStatement" + _InvalidTermError_emptyLetBindings = Core.Name "emptyLetBindings" + _InvalidTermError_emptyTermAnnotation = Core.Name "emptyTermAnnotation" + _InvalidTermError_emptyTypeNameInTerm = Core.Name "emptyTypeNameInTerm" + _InvalidTermError_invalidLambdaParameterName = Core.Name "invalidLambdaParameterName" + _InvalidTermError_invalidLetBindingName = Core.Name "invalidLetBindingName" + _InvalidTermError_invalidTypeLambdaParameterName = Core.Name "invalidTypeLambdaParameterName" + _InvalidTermError_nestedTermAnnotation = Core.Name "nestedTermAnnotation" + _InvalidTermError_redundantWrapUnwrap = Core.Name "redundantWrapUnwrap" + _InvalidTermError_selfApplication = Core.Name "selfApplication" + _InvalidTermError_termVariableShadowing = Core.Name "termVariableShadowing" + _InvalidTermError_typeVariableShadowingInTypeLambda = Core.Name "typeVariableShadowingInTypeLambda" + _InvalidTermError_undefinedTermVariable = Core.Name "undefinedTermVariable" + _InvalidTermError_undefinedTypeVariableInBindingType = Core.Name "undefinedTypeVariableInBindingType" + _InvalidTermError_undefinedTypeVariableInLambdaDomain = Core.Name "undefinedTypeVariableInLambdaDomain" + _InvalidTermError_undefinedTypeVariableInTypeApplication = Core.Name "undefinedTypeVariableInTypeApplication" + _InvalidTermError_unknownPrimitiveName = Core.Name "unknownPrimitiveName" + _InvalidTermError_unnecessaryIdentityApplication = Core.Name "unnecessaryIdentityApplication" + _InvalidTermError_untypedTermVariable = Core.Name "untypedTermVariable" + -- | An error indicating that a type is invalid data InvalidTypeError = -- | A record type with duplicate field names @@ -262,21 +346,37 @@ -- | TypeVoid in a position where no value can be constructed (optional) InvalidTypeErrorVoidInNonBottomPosition VoidInNonBottomPositionError deriving (Eq, Ord, Read, Show) + _InvalidTypeError = Core.Name "hydra.error.core.InvalidTypeError" + _InvalidTypeError_duplicateRecordTypeFieldNames = Core.Name "duplicateRecordTypeFieldNames" + _InvalidTypeError_duplicateUnionTypeFieldNames = Core.Name "duplicateUnionTypeFieldNames" + _InvalidTypeError_emptyRecordType = Core.Name "emptyRecordType" + _InvalidTypeError_emptyTypeAnnotation = Core.Name "emptyTypeAnnotation" + _InvalidTypeError_emptyUnionType = Core.Name "emptyUnionType" + _InvalidTypeError_invalidForallParameterName = Core.Name "invalidForallParameterName" + _InvalidTypeError_invalidTypeSchemeVariableName = Core.Name "invalidTypeSchemeVariableName" + _InvalidTypeError_nestedTypeAnnotation = Core.Name "nestedTypeAnnotation" + _InvalidTypeError_nonComparableMapKeyType = Core.Name "nonComparableMapKeyType" + _InvalidTypeError_nonComparableSetElementType = Core.Name "nonComparableSetElementType" + _InvalidTypeError_singleVariantUnion = Core.Name "singleVariantUnion" + _InvalidTypeError_typeVariableShadowingInForall = Core.Name "typeVariableShadowingInForall" + _InvalidTypeError_undefinedTypeVariable = Core.Name "undefinedTypeVariable" + _InvalidTypeError_voidInNonBottomPosition = Core.Name "voidInNonBottomPosition" + -- | A type lambda parameter name that violates naming conventions (optional) data InvalidTypeLambdaParameterNameError = InvalidTypeLambdaParameterNameError { @@ -285,9 +385,13 @@ -- | The invalid type lambda parameter name invalidTypeLambdaParameterNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _InvalidTypeLambdaParameterNameError = Core.Name "hydra.error.core.InvalidTypeLambdaParameterNameError" + _InvalidTypeLambdaParameterNameError_location = Core.Name "location" + _InvalidTypeLambdaParameterNameError_name = Core.Name "name" + -- | A type scheme variable name that violates type variable naming conventions (optional) data InvalidTypeSchemeVariableNameError = InvalidTypeSchemeVariableNameError { @@ -296,9 +400,13 @@ -- | The invalid variable name invalidTypeSchemeVariableNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _InvalidTypeSchemeVariableNameError = Core.Name "hydra.error.core.InvalidTypeSchemeVariableNameError" + _InvalidTypeSchemeVariableNameError_location = Core.Name "location" + _InvalidTypeSchemeVariableNameError_name = Core.Name "name" + -- | A mismatch between an expected literal type and the type of an actual literal value data LiteralTypeMismatchError = LiteralTypeMismatchError { @@ -307,25 +415,35 @@ -- | The actual literal type, derived from the value literalTypeMismatchErrorActualType :: Core.LiteralType} deriving (Eq, Ord, Read, Show) + _LiteralTypeMismatchError = Core.Name "hydra.error.core.LiteralTypeMismatchError" + _LiteralTypeMismatchError_expectedType = Core.Name "expectedType" + _LiteralTypeMismatchError_actualType = Core.Name "actualType" + -- | A term annotation directly wrapping another term annotation; annotations should be merged (optional) data NestedTermAnnotationError = NestedTermAnnotationError { -- | The path to the outer annotation within the term nestedTermAnnotationErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _NestedTermAnnotationError = Core.Name "hydra.error.core.NestedTermAnnotationError" + _NestedTermAnnotationError_location = Core.Name "location" + -- | A type annotation directly wrapping another type annotation; annotations should be merged (optional) data NestedTypeAnnotationError = NestedTypeAnnotationError { -- | The path to the outer annotation nestedTypeAnnotationErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _NestedTypeAnnotationError = Core.Name "hydra.error.core.NestedTypeAnnotationError" + _NestedTypeAnnotationError_location = Core.Name "location" + -- | A map type whose key type is or directly contains a function type, which cannot be compared for equality data NonComparableMapKeyTypeError = NonComparableMapKeyTypeError { @@ -334,9 +452,13 @@ -- | The non-comparable key type nonComparableMapKeyTypeErrorKeyType :: Core.Type} deriving (Eq, Ord, Read, Show) + _NonComparableMapKeyTypeError = Core.Name "hydra.error.core.NonComparableMapKeyTypeError" + _NonComparableMapKeyTypeError_location = Core.Name "location" + _NonComparableMapKeyTypeError_keyType = Core.Name "keyType" + -- | A set type whose element type is or directly contains a function type, which cannot be compared for equality data NonComparableSetElementTypeError = NonComparableSetElementTypeError { @@ -345,9 +467,13 @@ -- | The non-comparable element type nonComparableSetElementTypeErrorElementType :: Core.Type} deriving (Eq, Ord, Read, Show) + _NonComparableSetElementTypeError = Core.Name "hydra.error.core.NonComparableSetElementTypeError" + _NonComparableSetElementTypeError_location = Core.Name "location" + _NonComparableSetElementTypeError_elementType = Core.Name "elementType" + -- | An unwrap elimination applied to a wrap term of the same type, forming a no-op round-trip (optional) data RedundantWrapUnwrapError = RedundantWrapUnwrapError { @@ -356,9 +482,13 @@ -- | The type name of the wrapper redundantWrapUnwrapErrorTypeName :: Core.Name} deriving (Eq, Ord, Read, Show) + _RedundantWrapUnwrapError = Core.Name "hydra.error.core.RedundantWrapUnwrapError" + _RedundantWrapUnwrapError_location = Core.Name "location" + _RedundantWrapUnwrapError_typeName = Core.Name "typeName" + -- | A variable applied to itself, which is almost always a mistake in Hydra's type system (optional) data SelfApplicationError = SelfApplicationError { @@ -367,9 +497,13 @@ -- | The name of the variable applied to itself selfApplicationErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _SelfApplicationError = Core.Name "hydra.error.core.SelfApplicationError" + _SelfApplicationError_location = Core.Name "location" + _SelfApplicationError_name = Core.Name "name" + -- | A union type with exactly one field; could be a wrapped type or record instead (optional) data SingleVariantUnionError = SingleVariantUnionError { @@ -378,9 +512,13 @@ -- | The name of the single field singleVariantUnionErrorFieldName :: Core.Name} deriving (Eq, Ord, Read, Show) + _SingleVariantUnionError = Core.Name "hydra.error.core.SingleVariantUnionError" + _SingleVariantUnionError_location = Core.Name "location" + _SingleVariantUnionError_fieldName = Core.Name "fieldName" + -- | A lambda parameter or let binding name that shadows a variable already in scope (optional) data TermVariableShadowingError = TermVariableShadowingError { @@ -389,9 +527,13 @@ -- | The name of the shadowed variable termVariableShadowingErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _TermVariableShadowingError = Core.Name "hydra.error.core.TermVariableShadowingError" + _TermVariableShadowingError_location = Core.Name "location" + _TermVariableShadowingError_name = Core.Name "name" + -- | A forall type parameter that shadows a type variable already in scope (optional) data TypeVariableShadowingInForallError = TypeVariableShadowingInForallError { @@ -400,9 +542,13 @@ -- | The name of the shadowed type variable typeVariableShadowingInForallErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _TypeVariableShadowingInForallError = Core.Name "hydra.error.core.TypeVariableShadowingInForallError" + _TypeVariableShadowingInForallError_location = Core.Name "location" + _TypeVariableShadowingInForallError_name = Core.Name "name" + -- | A type lambda parameter that shadows a type variable already in scope (optional) data TypeVariableShadowingInTypeLambdaError = TypeVariableShadowingInTypeLambdaError { @@ -411,9 +557,13 @@ -- | The name of the shadowed type variable typeVariableShadowingInTypeLambdaErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _TypeVariableShadowingInTypeLambdaError = Core.Name "hydra.error.core.TypeVariableShadowingInTypeLambdaError" + _TypeVariableShadowingInTypeLambdaError_location = Core.Name "location" + _TypeVariableShadowingInTypeLambdaError_name = Core.Name "name" + -- | A reference to a field that does not exist in the given type data UndefinedFieldError = UndefinedFieldError { @@ -422,9 +572,13 @@ -- | The name of the type in which the field was expected undefinedFieldErrorTypeName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedFieldError = Core.Name "hydra.error.core.UndefinedFieldError" + _UndefinedFieldError_fieldName = Core.Name "fieldName" + _UndefinedFieldError_typeName = Core.Name "typeName" + -- | A variable reference to a term name that is not bound in scope data UndefinedTermVariableError = UndefinedTermVariableError { @@ -433,9 +587,13 @@ -- | The name of the undefined variable undefinedTermVariableErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTermVariableError = Core.Name "hydra.error.core.UndefinedTermVariableError" + _UndefinedTermVariableError_location = Core.Name "location" + _UndefinedTermVariableError_name = Core.Name "name" + -- | A type variable reference to a name that is not bound in scope data UndefinedTypeVariableError = UndefinedTypeVariableError { @@ -444,9 +602,13 @@ -- | The name of the undefined type variable undefinedTypeVariableErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTypeVariableError = Core.Name "hydra.error.core.UndefinedTypeVariableError" + _UndefinedTypeVariableError_location = Core.Name "location" + _UndefinedTypeVariableError_name = Core.Name "name" + -- | A type variable in a let binding's type scheme that is not bound by the scheme or enclosing scope data UndefinedTypeVariableInBindingTypeError = UndefinedTypeVariableInBindingTypeError { @@ -455,9 +617,13 @@ -- | The name of the undefined type variable undefinedTypeVariableInBindingTypeErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTypeVariableInBindingTypeError = Core.Name "hydra.error.core.UndefinedTypeVariableInBindingTypeError" + _UndefinedTypeVariableInBindingTypeError_location = Core.Name "location" + _UndefinedTypeVariableInBindingTypeError_name = Core.Name "name" + -- | A type variable in a lambda domain annotation that is not bound in scope data UndefinedTypeVariableInLambdaDomainError = UndefinedTypeVariableInLambdaDomainError { @@ -466,9 +632,13 @@ -- | The name of the undefined type variable undefinedTypeVariableInLambdaDomainErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTypeVariableInLambdaDomainError = Core.Name "hydra.error.core.UndefinedTypeVariableInLambdaDomainError" + _UndefinedTypeVariableInLambdaDomainError_location = Core.Name "location" + _UndefinedTypeVariableInLambdaDomainError_name = Core.Name "name" + -- | A type variable in a type application term that is not bound in scope data UndefinedTypeVariableInTypeApplicationError = UndefinedTypeVariableInTypeApplicationError { @@ -477,9 +647,13 @@ -- | The name of the undefined type variable undefinedTypeVariableInTypeApplicationErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UndefinedTypeVariableInTypeApplicationError = Core.Name "hydra.error.core.UndefinedTypeVariableInTypeApplicationError" + _UndefinedTypeVariableInTypeApplicationError_location = Core.Name "location" + _UndefinedTypeVariableInTypeApplicationError_name = Core.Name "name" + -- | An unexpected term variant was encountered data UnexpectedTermVariantError = UnexpectedTermVariantError { @@ -488,9 +662,13 @@ -- | The actual term that was encountered unexpectedTermVariantErrorActualTerm :: Core.Term} deriving (Eq, Ord, Read, Show) + _UnexpectedTermVariantError = Core.Name "hydra.error.core.UnexpectedTermVariantError" + _UnexpectedTermVariantError_expectedVariant = Core.Name "expectedVariant" + _UnexpectedTermVariantError_actualTerm = Core.Name "actualTerm" + -- | An unexpected type variant was encountered data UnexpectedTypeVariantError = UnexpectedTypeVariantError { @@ -499,9 +677,13 @@ -- | The actual type that was encountered unexpectedTypeVariantErrorActualType :: Core.Type} deriving (Eq, Ord, Read, Show) + _UnexpectedTypeVariantError = Core.Name "hydra.error.core.UnexpectedTypeVariantError" + _UnexpectedTypeVariantError_expectedVariant = Core.Name "expectedVariant" + _UnexpectedTypeVariantError_actualType = Core.Name "actualType" + -- | A primitive function reference to a name not in the known primitive registry data UnknownPrimitiveNameError = UnknownPrimitiveNameError { @@ -510,17 +692,24 @@ -- | The unknown primitive name unknownPrimitiveNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UnknownPrimitiveNameError = Core.Name "hydra.error.core.UnknownPrimitiveNameError" + _UnknownPrimitiveNameError_location = Core.Name "location" + _UnknownPrimitiveNameError_name = Core.Name "name" + -- | An application of an identity lambda to an argument, which simplifies to the argument (optional) data UnnecessaryIdentityApplicationError = UnnecessaryIdentityApplicationError { -- | The path to the identity application within the term unnecessaryIdentityApplicationErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _UnnecessaryIdentityApplicationError = Core.Name "hydra.error.core.UnnecessaryIdentityApplicationError" + _UnnecessaryIdentityApplicationError_location = Core.Name "location" + -- | A term variable whose type is not known in the current scope data UntypedTermVariableError = UntypedTermVariableError { @@ -529,14 +718,20 @@ -- | The name of the untyped variable untypedTermVariableErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _UntypedTermVariableError = Core.Name "hydra.error.core.UntypedTermVariableError" + _UntypedTermVariableError_location = Core.Name "location" + _UntypedTermVariableError_name = Core.Name "name" + -- | TypeVoid appearing in a position where no value can be constructed, such as a record field, list element, map key/value, set element, pair component, or function codomain (optional) data VoidInNonBottomPositionError = VoidInNonBottomPositionError { -- | The path to the void type in a non-bottom position voidInNonBottomPositionErrorLocation :: Paths.SubtermPath} deriving (Eq, Ord, Read, Show) + _VoidInNonBottomPositionError = Core.Name "hydra.error.core.VoidInNonBottomPositionError" + _VoidInNonBottomPositionError_location = Core.Name "location" diff --git a/src/main/haskell/Hydra/Error/File.hs b/src/main/haskell/Hydra/Error/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Error/File.hs @@ -0,0 +1,36 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | File-system error types + +module Hydra.Error.File where + +import qualified Hydra.Core as Core +import qualified Hydra.File as File +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | A recoverable file-system error +data FileError = + -- | A path already exists where one was required not to (POSIX EEXIST), e.g. creating a directory that is already present + FileErrorAlreadyExists File.FilePath | + -- | The path is syntactically invalid or cannot be represented by the host file system + FileErrorInvalidPath String | + -- | The requested path does not exist + FileErrorNotFound File.FilePath | + -- | Any other file-system error, represented as a host-provided message + FileErrorOther String | + -- | The host denied access to the requested path + FileErrorPermissionDenied File.FilePath + deriving (Eq, Ord, Read, Show) + +_FileError = Core.Name "hydra.error.file.FileError" + +_FileError_alreadyExists = Core.Name "alreadyExists" + +_FileError_invalidPath = Core.Name "invalidPath" + +_FileError_notFound = Core.Name "notFound" + +_FileError_other = Core.Name "other" + +_FileError_permissionDenied = Core.Name "permissionDenied" 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 @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Error types for module and package validation module Hydra.Error.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Packaging as Packaging import qualified Hydra.Util as Util import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | A module name which, when mapped to a target language's directory or package structure, conflicts with another module's mapped name. For example, hydra.foo.bar and hydra.fooBar might both map to the same directory in a case-insensitive filesystem. data ConflictingModuleNameError = ConflictingModuleNameError { @@ -15,9 +18,13 @@ -- | The second module name that conflicts with the first conflictingModuleNameErrorSecond :: Packaging.ModuleName} deriving (Eq, Ord, Read, Show) + _ConflictingModuleNameError = Core.Name "hydra.error.packaging.ConflictingModuleNameError" + _ConflictingModuleNameError_first = Core.Name "first" + _ConflictingModuleNameError_second = Core.Name "second" + -- | A union type variant name which, when capitalized and concatenated with its type name, conflicts with another type definition name. For example, a union type Foo with a variant bar produces FooBar, which conflicts with an existing type definition FooBar. This is currently a problem only for the Haskell target. data ConflictingVariantNameError = ConflictingVariantNameError { @@ -30,11 +37,17 @@ -- | The name of the other type definition that conflicts with the generated constructor name conflictingVariantNameErrorConflictingName :: Core.Name} deriving (Eq, Ord, Read, Show) + _ConflictingVariantNameError = Core.Name "hydra.error.packaging.ConflictingVariantNameError" + _ConflictingVariantNameError_moduleName = Core.Name "moduleName" + _ConflictingVariantNameError_typeName = Core.Name "typeName" + _ConflictingVariantNameError_variantName = Core.Name "variantName" + _ConflictingVariantNameError_conflictingName = Core.Name "conflictingName" + -- | A definition whose name does not have the module's name as a prefix. If the module name is foo.bar, all definition names must have the form foo.bar.quux. data DefinitionNotInModuleNameError = DefinitionNotInModuleNameError { @@ -43,9 +56,13 @@ -- | The definition name that does not match the module name definitionNotInModuleNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DefinitionNotInModuleNameError = Core.Name "hydra.error.packaging.DefinitionNotInModuleNameError" + _DefinitionNotInModuleNameError_moduleName = Core.Name "moduleName" + _DefinitionNotInModuleNameError_name = Core.Name "name" + -- | Two consecutive definitions in a module's definitions list that are not in alphabetical order by local name. Hydra requires definitions to appear in lexicographic ASCII order of their local names. data DefinitionsOutOfOrderError = DefinitionsOutOfOrderError { @@ -56,10 +73,15 @@ -- | The definition that appears next, but should sort earlier than precedingName definitionsOutOfOrderErrorFollowingName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DefinitionsOutOfOrderError = Core.Name "hydra.error.packaging.DefinitionsOutOfOrderError" + _DefinitionsOutOfOrderError_moduleName = Core.Name "moduleName" + _DefinitionsOutOfOrderError_precedingName = Core.Name "precedingName" + _DefinitionsOutOfOrderError_followingName = Core.Name "followingName" + -- | Two or more definitions in the same module share the same name data DuplicateDefinitionNameError = DuplicateDefinitionNameError { @@ -68,17 +90,24 @@ -- | The duplicated definition name duplicateDefinitionNameErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _DuplicateDefinitionNameError = Core.Name "hydra.error.packaging.DuplicateDefinitionNameError" + _DuplicateDefinitionNameError_moduleName = Core.Name "moduleName" + _DuplicateDefinitionNameError_name = Core.Name "name" + -- | Two or more modules in the same package share the same name data DuplicateModuleNameError = DuplicateModuleNameError { -- | The duplicated module name duplicateModuleNameErrorModuleName :: Packaging.ModuleName} deriving (Eq, Ord, Read, Show) + _DuplicateModuleNameError = Core.Name "hydra.error.packaging.DuplicateModuleNameError" + _DuplicateModuleNameError_moduleName = Core.Name "moduleName" + -- | A definition whose local name does not match the expected naming convention. Term-level definitions must be camelCase; type-level definitions must be PascalCase. data InvalidDefinitionNameError = InvalidDefinitionNameError { @@ -89,10 +118,15 @@ -- | The case convention the name should have followed (camel for term-level, pascal for type-level) invalidDefinitionNameErrorExpectedConvention :: Util.CaseConvention} deriving (Eq, Ord, Read, Show) + _InvalidDefinitionNameError = Core.Name "hydra.error.packaging.InvalidDefinitionNameError" + _InvalidDefinitionNameError_moduleName = Core.Name "moduleName" + _InvalidDefinitionNameError_name = Core.Name "name" + _InvalidDefinitionNameError_expectedConvention = Core.Name "expectedConvention" + -- | An error indicating that a module is invalid data InvalidModuleError = -- | A union variant name that conflicts with another type definition when mapped to a target language @@ -110,22 +144,34 @@ -- | A top-level definition lacking a description annotation InvalidModuleErrorMissingDocumentation MissingDocumentationError deriving (Eq, Ord, Read, Show) + _InvalidModuleError = Core.Name "hydra.error.packaging.InvalidModuleError" + _InvalidModuleError_conflictingVariantName = Core.Name "conflictingVariantName" + _InvalidModuleError_definitionNotInModuleName = Core.Name "definitionNotInModuleName" + _InvalidModuleError_definitionsOutOfOrder = Core.Name "definitionsOutOfOrder" + _InvalidModuleError_duplicateDefinitionName = Core.Name "duplicateDefinitionName" + _InvalidModuleError_invalidDefinitionName = Core.Name "invalidDefinitionName" + _InvalidModuleError_invalidModuleNameConvention = Core.Name "invalidModuleNameConvention" + _InvalidModuleError_missingDocumentation = Core.Name "missingDocumentation" + -- | A module whose name does not match the dotted-lowercase naming convention. Module names must be dot-separated lowercase segments, each starting with a letter, e.g. hydra.core or hydra.lib.lists. data InvalidModuleNameConventionError = InvalidModuleNameConventionError { -- | The module name that violates the convention invalidModuleNameConventionErrorModuleName :: Packaging.ModuleName} deriving (Eq, Ord, Read, Show) + _InvalidModuleNameConventionError = Core.Name "hydra.error.packaging.InvalidModuleNameConventionError" + _InvalidModuleNameConventionError_moduleName = Core.Name "moduleName" + -- | An error indicating that a package is invalid data InvalidPackageError = -- | Two module names that conflict when mapped to a target language @@ -137,19 +183,28 @@ -- | A package whose name does not match the package-name naming convention InvalidPackageErrorInvalidPackageName InvalidPackageNameError deriving (Eq, Ord, Read, Show) + _InvalidPackageError = Core.Name "hydra.error.packaging.InvalidPackageError" + _InvalidPackageError_conflictingModuleName = Core.Name "conflictingModuleName" + _InvalidPackageError_duplicateModuleName = Core.Name "duplicateModuleName" + _InvalidPackageError_invalidModule = Core.Name "invalidModule" + _InvalidPackageError_invalidPackageName = Core.Name "invalidPackageName" + -- | 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 { -- | The package name that violates the convention invalidPackageNameErrorPackageName :: Packaging.PackageName} deriving (Eq, Ord, Read, Show) + _InvalidPackageNameError = Core.Name "hydra.error.packaging.InvalidPackageNameError" + _InvalidPackageNameError_packageName = Core.Name "packageName" + -- | A top-level definition whose term (or type, for type definitions) lacks a description annotation. Every definition in a Hydra module is expected to be wrapped in a doc "..." annotation at its top level. data MissingDocumentationError = MissingDocumentationError { @@ -158,6 +213,9 @@ -- | The name of the undocumented definition missingDocumentationErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _MissingDocumentationError = Core.Name "hydra.error.packaging.MissingDocumentationError" + _MissingDocumentationError_moduleName = Core.Name "moduleName" + _MissingDocumentationError_name = Core.Name "name" diff --git a/src/main/haskell/Hydra/Error/System.hs b/src/main/haskell/Hydra/Error/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Error/System.hs @@ -0,0 +1,36 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | System-call error types + +module Hydra.Error.System where + +import qualified Hydra.Core as Core +import qualified Hydra.File as File +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci + +-- | A recoverable failure to launch a process or to perform a hydra.lib.system system call, named after the POSIX errno values the host reports. A child that launches successfully and then exits non-zero is not a SystemError; it is a ProcessResult with a non-zero exitCode +data SystemError = + -- | POSIX ENOENT: the executable named by Command.program does not exist or is not found on PATH. Reported by the exec family (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/execve.html) + SystemErrorCommandNotFound File.FilePath | + -- | POSIX EACCES: the executable exists but is not executable, or a path component denies search permission + SystemErrorPermissionDenied File.FilePath | + -- | POSIX ENOENT or ENOTDIR raised by the implied chdir() to Command.workingDirectory + SystemErrorInvalidWorkingDirectory File.FilePath | + -- | The call was interrupted before the child produced a result (a portable abstraction over POSIX EINTR and host-level kills); the child's disposition is unknown + SystemErrorInterrupted | + -- | Any other failure, carrying the host-provided error message verbatim (covers errno values not modeled above, such as EMFILE, ENOMEM, or E2BIG) + SystemErrorOther String + deriving (Eq, Ord, Read, Show) + +_SystemError = Core.Name "hydra.error.system.SystemError" + +_SystemError_commandNotFound = Core.Name "commandNotFound" + +_SystemError_permissionDenied = Core.Name "permissionDenied" + +_SystemError_invalidWorkingDirectory = Core.Name "invalidWorkingDirectory" + +_SystemError_interrupted = Core.Name "interrupted" + +_SystemError_other = Core.Name "other" diff --git a/src/main/haskell/Hydra/Errors.hs b/src/main/haskell/Hydra/Errors.hs --- a/src/main/haskell/Hydra/Errors.hs +++ b/src/main/haskell/Hydra/Errors.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Top-level error types for the Hydra kernel module Hydra.Errors where + import qualified Hydra.Core as Core import qualified Hydra.Error.Checking as Checking import qualified Hydra.Error.Core as ErrorCore @@ -10,15 +12,20 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | An error that occurred during decoding of a term newtype DecodingError = DecodingError { unDecodingError :: String} deriving (Eq, Ord, Read, Show) + _DecodingError = Core.Name "hydra.errors.DecodingError" + -- | An empty list was encountered where a non-empty list was required type EmptyListError = () + _EmptyListError = Core.Name "hydra.errors.EmptyListError" + -- | An error of any kind, with kernel errors particularly differentiated data Error = -- | A type checking error @@ -52,22 +59,39 @@ -- | A type unification error ErrorUnification UnificationError deriving (Eq, Ord, Read, Show) + _Error = Core.Name "hydra.errors.Error" + _Error_checking = Core.Name "checking" + _Error_decoding = Core.Name "decoding" + _Error_duplicateBinding = Core.Name "duplicateBinding" + _Error_duplicateField = Core.Name "duplicateField" + _Error_extraction = Core.Name "extraction" + _Error_inference = Core.Name "inference" + _Error_invalidLiteral = Core.Name "invalidLiteral" + _Error_other = Core.Name "other" + _Error_resolution = Core.Name "resolution" + _Error_undefinedField = Core.Name "undefinedField" + _Error_undefinedTermVariable = Core.Name "undefinedTermVariable" + _Error_untypedTermVariable = Core.Name "untypedTermVariable" + _Error_unexpectedTermVariant = Core.Name "unexpectedTermVariant" + _Error_unexpectedTypeVariant = Core.Name "unexpectedTypeVariant" + _Error_unification = Core.Name "unification" + -- | An error that occurred while extracting a typed value from a term data ExtractionError = -- | An empty list was encountered where a non-empty list was required @@ -85,14 +109,23 @@ -- | A term, type, literal, or other value had an unexpected shape ExtractionErrorUnexpectedShape UnexpectedShapeError deriving (Eq, Ord, Read, Show) + _ExtractionError = Core.Name "hydra.errors.ExtractionError" + _ExtractionError_emptyList = Core.Name "emptyList" + _ExtractionError_multipleBindings = Core.Name "multipleBindings" + _ExtractionError_multipleFields = Core.Name "multipleFields" + _ExtractionError_noMatchingField = Core.Name "noMatchingField" + _ExtractionError_noSuchBinding = Core.Name "noSuchBinding" + _ExtractionError_notEnoughCases = Core.Name "notEnoughCases" + _ExtractionError_unexpectedShape = Core.Name "unexpectedShape" + -- | An error that occurred during type inference data InferenceError = -- | A type checking error encountered during inference @@ -102,59 +135,83 @@ -- | A unification failure encountered while inferring types InferenceErrorUnification UnificationInferenceError deriving (Eq, Ord, Read, Show) + _InferenceError = Core.Name "hydra.errors.InferenceError" + _InferenceError_checking = Core.Name "checking" + _InferenceError_other = Core.Name "other" + _InferenceError_unification = Core.Name "unification" + -- | Multiple let bindings with the same name were found data MultipleBindingsError = MultipleBindingsError { -- | The binding name which was duplicated multipleBindingsErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _MultipleBindingsError = Core.Name "hydra.errors.MultipleBindingsError" + _MultipleBindingsError_name = Core.Name "name" + -- | Multiple fields with the same name were found in a record data MultipleFieldsError = MultipleFieldsError { -- | The field name which appeared more than once multipleFieldsErrorFieldName :: Core.Name} deriving (Eq, Ord, Read, Show) + _MultipleFieldsError = Core.Name "hydra.errors.MultipleFieldsError" + _MultipleFieldsError_fieldName = Core.Name "fieldName" + -- | No field with the expected name was present data NoMatchingFieldError = NoMatchingFieldError { -- | The field name which was not found noMatchingFieldErrorFieldName :: Core.Name} deriving (Eq, Ord, Read, Show) + _NoMatchingFieldError = Core.Name "hydra.errors.NoMatchingFieldError" + _NoMatchingFieldError_fieldName = Core.Name "fieldName" + -- | No let binding with the expected name was present data NoSuchBindingError = NoSuchBindingError { -- | The binding name which was not found noSuchBindingErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _NoSuchBindingError = Core.Name "hydra.errors.NoSuchBindingError" + _NoSuchBindingError_name = Core.Name "name" + -- | No primitive function with the expected name was registered in the graph data NoSuchPrimitiveError = NoSuchPrimitiveError { -- | The primitive name which was not found noSuchPrimitiveErrorName :: Core.Name} deriving (Eq, Ord, Read, Show) + _NoSuchPrimitiveError = Core.Name "hydra.errors.NoSuchPrimitiveError" + _NoSuchPrimitiveError_name = Core.Name "name" + -- | A case statement was missing a case for the requested variant type NotEnoughCasesError = () + _NotEnoughCasesError = Core.Name "hydra.errors.NotEnoughCasesError" + -- | Any other error newtype OtherError = OtherError { unOtherError :: String} deriving (Eq, Ord, Read, Show) + _OtherError = Core.Name "hydra.errors.OtherError" + -- | A generic inference error: message + subterm path data OtherInferenceError = OtherInferenceError { @@ -163,15 +220,21 @@ -- | A human-readable error message otherInferenceErrorMessage :: String} deriving (Eq, Ord, Read, Show) + _OtherInferenceError = Core.Name "hydra.errors.OtherInferenceError" + _OtherInferenceError_path = Core.Name "path" + _OtherInferenceError_message = Core.Name "message" + -- | A generic resolution error: message newtype OtherResolutionError = OtherResolutionError { unOtherResolutionError :: String} deriving (Eq, Ord, Read, Show) + _OtherResolutionError = Core.Name "hydra.errors.OtherResolutionError" + -- | An error that occurred while resolving a name, primitive, or record/union shape in a graph data ResolutionError = -- | No binding with the expected name was found in the graph @@ -185,12 +248,19 @@ -- | A term had a shape other than the one expected (e.g. a record, an injection) ResolutionErrorUnexpectedShape UnexpectedShapeError deriving (Eq, Ord, Read, Show) + _ResolutionError = Core.Name "hydra.errors.ResolutionError" + _ResolutionError_noSuchBinding = Core.Name "noSuchBinding" + _ResolutionError_noSuchPrimitive = Core.Name "noSuchPrimitive" + _ResolutionError_noMatchingField = Core.Name "noMatchingField" + _ResolutionError_other = Core.Name "other" + _ResolutionError_unexpectedShape = Core.Name "unexpectedShape" + -- | A term, type, literal, or related value had a shape other than the one expected data UnexpectedShapeError = UnexpectedShapeError { @@ -199,9 +269,13 @@ -- | A description of the shape actually encountered unexpectedShapeErrorActual :: String} deriving (Eq, Ord, Read, Show) + _UnexpectedShapeError = Core.Name "hydra.errors.UnexpectedShapeError" + _UnexpectedShapeError_expected = Core.Name "expected" + _UnexpectedShapeError_actual = Core.Name "actual" + -- | An error that occurred during type unification data UnificationError = UnificationError { @@ -212,10 +286,15 @@ -- | A human-readable error message unificationErrorMessage :: String} deriving (Eq, Ord, Read, Show) + _UnificationError = Core.Name "hydra.errors.UnificationError" + _UnificationError_leftType = Core.Name "leftType" + _UnificationError_rightType = Core.Name "rightType" + _UnificationError_message = Core.Name "message" + -- | A unification failure at a specific subterm locus during inference data UnificationInferenceError = UnificationInferenceError { @@ -224,6 +303,9 @@ -- | The underlying unification error unificationInferenceErrorCause :: UnificationError} deriving (Eq, Ord, Read, Show) + _UnificationInferenceError = Core.Name "hydra.errors.UnificationInferenceError" + _UnificationInferenceError_path = Core.Name "path" + _UnificationInferenceError_cause = Core.Name "cause" 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 @@ -1,27 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Extraction and validation for hydra.core types module Hydra.Extract.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.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -30,8 +36,10 @@ 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 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 @@ -44,9 +52,11 @@ import qualified Data.Int as I import qualified Data.Map as M import qualified Data.Set as S + -- | Extract an arbitrary-precision integer value from a term bigint :: Graph.Graph -> Core.Term -> Either Errors.Error Integer bigint graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> bigintValue i)) + -- | Extract a bigint value from an IntegerValue bigintValue :: Core.IntegerValue -> Either Errors.Error Integer bigintValue v = @@ -55,9 +65,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "bigint", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract a binary data value from a term binary :: Graph.Graph -> Core.Term -> Either Errors.Error B.ByteString binary graph t = Eithers.bind (literal graph t) (\l -> binaryLiteral l) + -- | Extract a binary literal from a Literal value binaryLiteral :: Core.Literal -> Either Errors.Error B.ByteString binaryLiteral v = @@ -66,9 +78,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "binary", Errors.unexpectedShapeErrorActual = (ShowCore.literal v)}))) + -- | Extract a boolean value from a term boolean :: Graph.Graph -> Core.Term -> Either Errors.Error Bool boolean graph t = Eithers.bind (literal graph t) (\l -> booleanLiteral l) + -- | Extract a boolean literal from a Literal value booleanLiteral :: Core.Literal -> Either Errors.Error Bool booleanLiteral v = @@ -77,6 +91,7 @@ _ -> 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 = @@ -88,6 +103,7 @@ in (Optionals.cases matching (Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "matching case", Errors.unexpectedShapeErrorActual = "no matching case"})))) (\mf -> Right mf)))) + -- | Extract case statement from a term cases :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error Core.CaseStatement cases name graph term0 = @@ -98,9 +114,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "case statement", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract an arbitrary-precision decimal value from a term decimal :: Graph.Graph -> Core.Term -> Either Errors.Error Sci.Scientific decimal graph t = Eithers.bind (literal graph t) (\l -> decimalLiteral l) + -- | Extract a decimal literal from a Literal value decimalLiteral :: Core.Literal -> Either Errors.Error Sci.Scientific decimalLiteral v = @@ -109,54 +127,63 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "decimal", Errors.unexpectedShapeErrorActual = (ShowCore.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) decodeEither leftDecoder rightDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermEither v0 -> Eithers.either (\lv -> Eithers.map (\x -> Left x) (leftDecoder g lv)) (\rv -> Eithers.map (\x -> Right x) (rightDecoder g rv)) v0 _ -> Left (Errors.DecodingError "expected either value")) + -- | Decode a list of elements using the provided element decoder decodeList :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError [t0] decodeList elemDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermList v0 -> Eithers.mapList (elemDecoder g) v0 _ -> Left (Errors.DecodingError "expected list")) + -- | Decode a Map using the provided key and value decoders decodeMap :: Ord t0 => ((Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> (Graph.Graph -> Core.Term -> Either Errors.DecodingError t1) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (M.Map t0 t1)) decodeMap keyDecoder valDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermMap v0 -> Eithers.map Maps.fromList (Eithers.mapList (\kv -> Eithers.bind (keyDecoder g (Pairs.first kv)) (\k -> Eithers.map (\v -> (k, v)) (valDecoder g (Pairs.second kv)))) (Maps.toList v0)) _ -> Left (Errors.DecodingError "expected map")) + -- | Decode a Maybe value using the provided element decoder decodeMaybe :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (Maybe t0) decodeMaybe elemDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermOptional v0 -> Eithers.mapOptional (elemDecoder g) v0 _ -> Left (Errors.DecodingError "expected optional value")) + -- | Decode a Pair using the provided first and second decoders decodePair :: (Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> (Graph.Graph -> Core.Term -> Either Errors.DecodingError t1) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (t0, t1) decodePair firstDecoder secondDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermPair v0 -> Eithers.bind (firstDecoder g (Pairs.first v0)) (\f -> Eithers.map (\s -> (f, s)) (secondDecoder g (Pairs.second v0))) _ -> Left (Errors.DecodingError "expected pair")) + -- | Decode a Set using the provided element decoder decodeSet :: Ord t0 => ((Graph.Graph -> Core.Term -> Either Errors.DecodingError t0) -> Graph.Graph -> Core.Term -> Either Errors.DecodingError (S.Set t0)) decodeSet elemDecoder g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of Core.TermSet v0 -> Eithers.map Sets.fromList (Eithers.mapList (elemDecoder g) (Sets.toList v0)) _ -> Left (Errors.DecodingError "expected set")) + -- | Decode a unit value decodeUnit :: Graph.Graph -> Core.Term -> Either Errors.DecodingError () decodeUnit g term = Eithers.bind (stripWithDecodingError g term) (\stripped -> case stripped of 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 = @@ -165,6 +192,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "either value", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract the left and right types from an either type eitherType :: Core.Type -> Either Errors.Error Core.EitherType eitherType typ = @@ -175,6 +203,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "either type", Errors.unexpectedShapeErrorActual = (ShowCore.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 field fname mapping graph fields = @@ -187,9 +216,11 @@ 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 { Errors.unexpectedShapeErrorExpected = "single field", Errors.unexpectedShapeErrorActual = (Strings.cat2 "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 float32 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (floatLiteral l) (\f -> float32Value f)) + -- | Extract a float32 value from a FloatValue float32Value :: Core.FloatValue -> Either Errors.Error Float float32Value v = @@ -198,9 +229,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "float32", Errors.unexpectedShapeErrorActual = (ShowCore.float v)}))) + -- | Extract a 64-bit floating-point value from a term float64 :: Graph.Graph -> Core.Term -> Either Errors.Error Double float64 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (floatLiteral l) (\f -> float64Value f)) + -- | Extract a float64 value from a FloatValue float64Value :: Core.FloatValue -> Either Errors.Error Double float64Value v = @@ -209,6 +242,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "float64", Errors.unexpectedShapeErrorActual = (ShowCore.float v)}))) + -- | Extract a floating-point literal from a Literal value floatLiteral :: Core.Literal -> Either Errors.Error Core.FloatValue floatLiteral lit = @@ -217,9 +251,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "floating-point value", Errors.unexpectedShapeErrorActual = (ShowCore.literal lit)}))) + -- | Extract a float value from a term floatValue :: Graph.Graph -> Core.Term -> Either Errors.Error Core.FloatValue floatValue graph t = Eithers.bind (literal graph t) (\l -> floatLiteral l) + -- | Extract a function type from a type functionType :: Core.Type -> Either Errors.Error Core.FunctionType functionType typ = @@ -230,6 +266,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "function type", Errors.unexpectedShapeErrorActual = (ShowCore.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 = @@ -240,9 +277,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "injection", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract a 16-bit signed integer value from a term int16 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int16 int16 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> int16Value i)) + -- | Extract an int16 value from an IntegerValue int16Value :: Core.IntegerValue -> Either Errors.Error I.Int16 int16Value v = @@ -251,9 +290,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int16", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract a 32-bit signed integer value from a term int32 :: Graph.Graph -> Core.Term -> Either Errors.Error Int int32 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> int32Value i)) + -- | Extract an int32 value from an IntegerValue int32Value :: Core.IntegerValue -> Either Errors.Error Int int32Value v = @@ -262,9 +303,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int32", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract a 64-bit signed integer value from a term int64 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int64 int64 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> int64Value i)) + -- | Extract an int64 value from an IntegerValue int64Value :: Core.IntegerValue -> Either Errors.Error I.Int64 int64Value v = @@ -273,9 +316,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int64", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract an 8-bit signed integer value from a term int8 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int8 int8 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> int8Value i)) + -- | Extract an int8 value from an IntegerValue int8Value :: Core.IntegerValue -> Either Errors.Error I.Int8 int8Value v = @@ -284,6 +329,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "int8", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract an integer literal from a Literal value integerLiteral :: Core.Literal -> Either Errors.Error Core.IntegerValue integerLiteral lit = @@ -292,9 +338,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "integer value", Errors.unexpectedShapeErrorActual = (ShowCore.literal lit)}))) + -- | Extract an integer value from a term integerValue :: Graph.Graph -> Core.Term -> Either Errors.Error Core.IntegerValue integerValue graph t = Eithers.bind (literal graph t) (\l -> integerLiteral l) + -- | Extract a lambda from a term lambda :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Lambda lambda graph term0 = @@ -303,9 +351,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "lambda", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract the body of a lambda term lambdaBody :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Term lambdaBody graph term = Eithers.map Core.lambdaBody (lambda graph term) + -- | Extract a let expression from a term let_ :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Let let_ graph term0 = @@ -314,6 +364,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "let term", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract a binding with the given name from a let term letBinding :: String -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term letBinding n graph term = @@ -327,6 +378,7 @@ 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 { Errors.multipleBindingsErrorName = name})))))))) + -- | Extract a list of terms from a term list :: Graph.Graph -> Core.Term -> Either Errors.Error [Core.Term] list graph term = @@ -335,15 +387,18 @@ _ -> 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)) + -- | 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] listOf f graph term = Eithers.bind (list graph term) (\els -> Eithers.mapList f els) + -- | Extract the element type from a list type listType :: Core.Type -> Either Errors.Error Core.Type listType typ = @@ -354,6 +409,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "list type", Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + -- | Extract a literal value from a term literal :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Literal literal graph term0 = @@ -362,6 +418,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "literal", Errors.unexpectedShapeErrorActual = (ShowCore.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)) map fk fv graph term0 = @@ -376,6 +433,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "map", Errors.unexpectedShapeErrorActual = (ShowCore.term term)}))))) + -- | Extract the key and value types from a map type mapType :: Core.Type -> Either Errors.Error Core.MapType mapType typ = @@ -386,6 +444,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "map type", Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + -- | Ensure a function has the expected number of arguments nArgs :: Core.Name -> Int -> [t0] -> Either Errors.Error () nArgs name n args = @@ -395,6 +454,7 @@ " arguments to primitive ", (Literals.showString (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 optionalTerm :: (Core.Term -> Either Errors.Error t0) -> Graph.Graph -> Core.Term -> Either Errors.Error (Maybe t0) optionalTerm f graph term0 = @@ -403,6 +463,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "optional value", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract the base type from an optional type optionalType :: Core.Type -> Either Errors.Error Core.Type optionalType typ = @@ -413,6 +474,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "optional type", Errors.unexpectedShapeErrorActual = (ShowCore.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) pair kf vf graph term0 = @@ -421,12 +483,14 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "pair", Errors.unexpectedShapeErrorActual = (ShowCore.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.unexpectedShapeErrorActual = (Core.unName (Core.recordTypeName record))}))))) + -- | Extract the field types from a record type recordType :: t0 -> Core.Type -> Either Errors.Error [Core.FieldType] recordType ename typ = @@ -437,6 +501,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record type", Errors.unexpectedShapeErrorActual = (ShowCore.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 = @@ -444,6 +509,7 @@ "missing field ", fieldName, " in record"]))) (\fieldTerm -> decoder g fieldTerm) + -- | Extract a set of terms from a term set :: Graph.Graph -> Core.Term -> Either Errors.Error (S.Set Core.Term) set graph term = @@ -452,9 +518,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "set", Errors.unexpectedShapeErrorActual = (ShowCore.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)) setOf f graph term = Eithers.bind (set graph term) (\els -> Eithers.mapSet f els) + -- | Extract the element type from a set type setType :: Core.Type -> Either Errors.Error Core.Type setType typ = @@ -465,9 +533,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "set type", Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + -- | Extract a string value from a term string :: Graph.Graph -> Core.Term -> Either Errors.Error String string graph t = Eithers.bind (literal graph t) (\l -> stringLiteral l) + -- | Extract a string literal from a Literal value stringLiteral :: Core.Literal -> Either Errors.Error String stringLiteral v = @@ -476,10 +546,12 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "string", Errors.unexpectedShapeErrorActual = (ShowCore.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) + -- | Extract a record from a term termRecord :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Record termRecord graph term0 = @@ -488,12 +560,15 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record", Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Convert a Record's fields to a Map from Name to Term toFieldMap :: Core.Record -> M.Map Core.Name Core.Term toFieldMap record = Maps.fromList (Lists.map (\f -> (Core.fieldName f, (Core.fieldTerm f))) (Core.recordFields record)) + -- | Extract a 16-bit unsigned integer value from a term uint16 :: Graph.Graph -> Core.Term -> Either Errors.Error Int uint16 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> uint16Value i)) + -- | Extract a uint16 value from an IntegerValue uint16Value :: Core.IntegerValue -> Either Errors.Error Int uint16Value v = @@ -502,9 +577,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint16", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract a 32-bit unsigned integer value from a term uint32 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int64 uint32 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> uint32Value i)) + -- | Extract a uint32 value from an IntegerValue uint32Value :: Core.IntegerValue -> Either Errors.Error I.Int64 uint32Value v = @@ -513,9 +590,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint32", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract a 64-bit unsigned integer value from a term uint64 :: Graph.Graph -> Core.Term -> Either Errors.Error Integer uint64 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> uint64Value i)) + -- | Extract a uint64 value from an IntegerValue uint64Value :: Core.IntegerValue -> Either Errors.Error Integer uint64Value v = @@ -524,9 +603,11 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint64", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract an 8-bit unsigned integer value from a term uint8 :: Graph.Graph -> Core.Term -> Either Errors.Error I.Int16 uint8 graph t = Eithers.bind (literal graph t) (\l -> Eithers.bind (integerLiteral l) (\i -> uint8Value i)) + -- | Extract a uint8 value from an IntegerValue uint8Value :: Core.IntegerValue -> Either Errors.Error I.Int16 uint8Value v = @@ -535,6 +616,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "uint8", Errors.unexpectedShapeErrorActual = (ShowCore.integer v)}))) + -- | Extract the field types from a union type unionType :: t0 -> Core.Type -> Either Errors.Error [Core.FieldType] unionType ename typ = @@ -545,6 +627,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "union type", Errors.unexpectedShapeErrorActual = (ShowCore.type_ typ)}))) + -- | Extract a unit value from a term unit :: Core.Term -> Either Errors.Error () unit term = @@ -553,10 +636,12 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "unit", Errors.unexpectedShapeErrorActual = (ShowCore.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 unitVariant tname graph term = Eithers.bind (injection tname graph term) (\field -> Eithers.bind (unit (Core.fieldTerm field)) (\ignored -> Right (Core.fieldName field))) + -- | Extract the wrapped value from a wrapped term wrap :: Core.Name -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term wrap expected graph term0 = @@ -567,6 +652,7 @@ _ -> Left (Errors.ErrorExtraction (Errors.ExtractionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = (Strings.cat2 (Strings.cat2 "wrap(" (Core.unName expected)) ")"), Errors.unexpectedShapeErrorActual = (ShowCore.term term)})))) + -- | Extract the wrapped type from a wrapper type wrappedType :: t0 -> Core.Type -> Either Errors.Error Core.Type wrappedType ename 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 @@ -1,27 +1,35 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Utilities for extracting values from JSON objects module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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 @@ -31,39 +39,47 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Extract an array from a JSON value, failing if the value is not an array expectArray :: Model.Value -> Either String [Model.Value] expectArray value = case value of Model.ValueArray v0 -> Right v0 _ -> Left (Strings.cat2 (Strings.cat2 "expected " "JSON array") (Strings.cat2 " 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))) + -- | 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))) + -- | 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))) + -- | Look up an optional field in a JSON object opt :: Ord t0 => (t0 -> M.Map t0 t1 -> Maybe t1) opt fname m = Maps.lookup fname m + -- | Look up an optional array field in a JSON object optArray :: Ord t0 => (t0 -> M.Map t0 Model.Value -> Either String (Maybe [Model.Value])) optArray fname m = Optionals.cases (opt fname m) (Right Nothing) (\a -> Eithers.map (\x -> Just x) (expectArray a)) + -- | Look up an optional string field in a JSON object optString :: Ord t0 => (t0 -> M.Map t0 Model.Value -> Either String (Maybe String)) 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 fname m = @@ -71,15 +87,19 @@ "required attribute ", (showValue 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 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 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 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" 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 @@ -1,28 +1,36 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Extraction and validation for hydra.util types module Hydra.Extract.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality +import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic 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.Errors as ShowErrors +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 @@ -31,6 +39,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Extract a comparison from a term comparison :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Util.Comparison comparison cx graph term = diff --git a/src/main/haskell/Hydra/File.hs b/src/main/haskell/Hydra/File.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/File.hs @@ -0,0 +1,88 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A model for file-system paths and metadata. Several types here are drawn from the POSIX specification; see https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/sys_stat.h.html + +module Hydra.File where + +import qualified Hydra.Core as Core +import qualified Hydra.Time as Time +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.Int as I + +-- | A file extension (without the dot), e.g. "json" or "py" +newtype FileExtension = + FileExtension { + unFileExtension :: String} + deriving (Eq, Ord, Read, Show) + +_FileExtension = Core.Name "hydra.file.FileExtension" + +-- | A host file-system path; a POSIX "pathname" (XBD section 3.254), i.e. a string used to identify a file. Named FilePath rather than Pathname so that the kernel type is self-describing and distinct from Hydra's other notions of paths +newtype FilePath = + FilePath { + unFilePath :: String} + deriving (Eq, Ord, Read, Show) + +_FilePath = Core.Name "hydra.file.FilePath" + +-- | Metadata about a file, based on the POSIX struct stat. Only the portable, cross-platform subset of struct stat is modeled here; the following Unix-specific fields are omitted for now: st_dev (device ID), st_ino (inode number), st_mode permission bits (only the file type bits are kept, as fileType), st_nlink (hard link count), st_uid (owner user ID), st_gid (owner group ID), st_rdev (device ID for special files), st_blksize (preferred I/O block size), and st_blocks (number of blocks allocated). See (https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/sys_stat.h.html) +data FileStatus = + FileStatus { + -- | st_mode (file type bits) / the type of the file + fileStatusFileType :: FileType, + -- | st_size / the size of the file in bytes. Well-defined for regular files and symbolic links; implementation-defined for other file types + fileStatusSize :: I.Int64, + -- | st_mtim / the time of last data modification + fileStatusModificationTime :: Time.Timespec, + -- | st_atim / the time of last data access, if available. Optional, as it is unreliable or untracked on some filesystems and platforms (e.g. noatime mounts) + fileStatusAccessTime :: (Maybe Time.Timespec), + -- | st_ctim / the time of last file status change, if available. Optional, as this POSIX-specific notion does not map onto all platforms + fileStatusStatusChangeTime :: (Maybe Time.Timespec)} + deriving (Eq, Ord, Read, Show) + +_FileStatus = Core.Name "hydra.file.FileStatus" + +_FileStatus_fileType = Core.Name "fileType" + +_FileStatus_size = Core.Name "size" + +_FileStatus_modificationTime = Core.Name "modificationTime" + +_FileStatus_accessTime = Core.Name "accessTime" + +_FileStatus_statusChangeTime = Core.Name "statusChangeTime" + +-- | An enumeration of POSIX file types, following the file type macros of +data FileType = + -- | S_IFBLK / block special: a block special file (e.g. a disk device) + FileTypeBlock | + -- | S_IFCHR / character special: a character special file (e.g. a terminal device) + FileTypeCharacter | + -- | S_IFDIR / directory: a directory + FileTypeDirectory | + -- | S_IFIFO / FIFO special: a named pipe (FIFO) + FileTypeFifo | + -- | S_IFREG / regular: a regular file + FileTypeRegular | + -- | S_IFLNK / symbolic link: a symbolic link + FileTypeLink | + -- | S_IFSOCK / socket: a socket + FileTypeSocket + deriving (Eq, Ord, Read, Show) + +_FileType = Core.Name "hydra.file.FileType" + +_FileType_block = Core.Name "block" + +_FileType_character = Core.Name "character" + +_FileType_directory = Core.Name "directory" + +_FileType_fifo = Core.Name "fifo" + +_FileType_regular = Core.Name "regular" + +_FileType_link = Core.Name "link" + +_FileType_socket = Core.Name "socket" 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 @@ -1,33 +1,41 @@ -- Note: this is an automatically generated file. Do not edit. + -- | String formatting types and functions. module Hydra.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.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.Haskell.Lib.Chars as Chars -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Chars as Chars +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.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.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 @@ -37,9 +45,11 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | Capitalize the first letter of a string capitalize :: String -> String capitalize = mapFirstLetter Strings.toUpper + -- | Convert a string from one case convention to another convertCase :: Util.CaseConvention -> Util.CaseConvention -> String -> String convertCase from to original = @@ -64,6 +74,7 @@ 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) + -- | 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 convertCaseCamelOrUnderscoreToLowerSnake s = @@ -71,30 +82,38 @@ let parts = Strings.splitOn "_" s snakeParts = Lists.map (\p -> convertCaseCamelToLowerSnake p) parts in (Strings.intercalate "_" snakeParts) + -- | Convert a string from camel case to lower snake case convertCaseCamelToLowerSnake :: String -> String convertCaseCamelToLowerSnake = convertCase Util.CaseConventionCamel Util.CaseConventionLowerSnake + -- | Convert a string from camel case to upper snake case convertCaseCamelToUpperSnake :: String -> String convertCaseCamelToUpperSnake = convertCase Util.CaseConventionCamel Util.CaseConventionUpperSnake + -- | Convert a string from pascal case to upper snake case convertCasePascalToUpperSnake :: String -> String convertCasePascalToUpperSnake = convertCase Util.CaseConventionPascal Util.CaseConventionUpperSnake + -- | Decapitalize the first letter of a string decapitalize :: String -> String decapitalize = mapFirstLetter Strings.toLower + -- | 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 + -- | Indent each line of a string with four spaces indentLines :: String -> String indentLines s = let indent = \l -> Strings.cat2 " " 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 */" + -- | A helper which maps the first letter of a string to another string mapFirstLetter :: (String -> String) -> String -> String mapFirstLetter mapping s = @@ -103,6 +122,7 @@ in (Optionals.fromOptional 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)))) + -- | Replace sequences of non-alphanumeric characters with single underscores nonAlnumToUnderscores :: String -> String nonAlnumToUnderscores input = @@ -116,6 +136,7 @@ in (Logic.ifElse (isAlnum c) (Lists.cons c s, False) (Logic.ifElse b (s, True) (Lists.cons 95 s, True))) result = Lists.foldl replace ([], False) (Strings.toList input) in (Strings.fromList (Lists.reverse (Pairs.first result))) + -- | Normalize a comment string for consistent output across coders normalizeComment :: String -> String normalizeComment s = @@ -125,9 +146,11 @@ 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)))) + -- | Sanitize a string by replacing non-alphanumeric characters and escaping reserved words sanitizeWithUnderscores :: S.Set String -> String -> String sanitizeWithUnderscores reserved s = escapeWithUnderscore reserved (nonAlnumToUnderscores s) + -- | Format a list of elements as a bracketed, comma-separated string showList :: (t0 -> String) -> [t0] -> String showList f els = @@ -135,10 +158,12 @@ "[", (Strings.intercalate ", " (Lists.map f els)), "]"] + -- | Remove leading and trailing whitespace from a string stripLeadingAndTrailingWhitespace :: String -> String stripLeadingAndTrailingWhitespace s = Strings.fromList (Lists.dropWhile Chars.isSpace (Lists.reverse (Lists.dropWhile Chars.isSpace (Lists.reverse (Strings.toList s))))) + -- | Replace special characters with their alphanumeric aliases withCharacterAliases :: String -> String withCharacterAliases original = @@ -180,6 +205,7 @@ (126, "tilde")] alias = \c -> Optionals.fromOptional (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 wrapLine :: Int -> String -> String wrapLine maxlen input = diff --git a/src/main/haskell/Hydra/Graph.hs b/src/main/haskell/Hydra/Graph.hs --- a/src/main/haskell/Hydra/Graph.hs +++ b/src/main/haskell/Hydra/Graph.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | The extension to graphs of Hydra's core type system (hydra.core) module Hydra.Graph where + import qualified Hydra.Core as Core import qualified Hydra.Errors as Errors import qualified Hydra.Packaging as Packaging @@ -10,6 +12,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | A graph, or lexical environment which binds names to terms, types, primitives, and metadata data Graph = Graph { @@ -29,15 +32,25 @@ graphSchemaTypes :: (M.Map Core.Name Core.TypeScheme), -- | The set of type variables introduced specifically by type lambdas graphTypeVariables :: (S.Set Core.Name)} + _Graph = Core.Name "hydra.graph.Graph" + _Graph_boundTerms = Core.Name "boundTerms" + _Graph_boundTypes = Core.Name "boundTypes" + _Graph_classConstraints = Core.Name "classConstraints" + _Graph_lambdaVariables = Core.Name "lambdaVariables" + _Graph_metadata = Core.Name "metadata" + _Graph_primitives = Core.Name "primitives" + _Graph_schemaTypes = Core.Name "schemaTypes" + _Graph_typeVariables = Core.Name "typeVariables" + -- | A library of primitive functions data Library = Library { @@ -47,10 +60,15 @@ libraryPrefix :: String, -- | The primitives defined in this library libraryPrimitives :: [Primitive]} + _Library = Core.Name "hydra.graph.Library" + _Library_name = Core.Name "name" + _Library_prefix = Core.Name "prefix" + _Library_primitives = Core.Name "primitives" + -- | A built-in function or constant, consisting of the host-independent PrimitiveDefinition (name, signature, metadata) plus a host-specific implementation. data Primitive = Primitive { @@ -58,9 +76,13 @@ primitiveDefinition :: Packaging.PrimitiveDefinition, -- | A concrete, host-specific implementation of the primitive function: given the current graph, a mapping from a list of argument terms to a result term, or an error. Arguments are reduced and stripped of annotations by the interpreter before the implementation is invoked, so the implementation can pattern-match the argument terms directly; a higher-order primitive whose result shape is fixed by its data argument can return an unreduced applicative term and let the outer reducer fold it (no graph needed). The graph is retained for the higher-order primitives that must evaluate a function argument mid-computation (e.g. lists.filter): evaluating that function resolves primitive names against the graph's primitive table. The legacy `InferenceContext` parameter was vestigial and has been removed (https://github.com/CategoricalData/hydra/issues/446). primitiveImplementation :: (Graph -> [Core.Term] -> Either Errors.Error Core.Term)} + _Primitive = Core.Name "hydra.graph.Primitive" + _Primitive_definition = Core.Name "definition" + _Primitive_implementation = Core.Name "implementation" + -- | A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms. data TermCoder a = TermCoder { @@ -70,7 +92,11 @@ termCoderEncode :: (Typing.InferenceContext -> Graph -> Core.Term -> Either Errors.Error a), -- | A decode function from native values to terms termCoderDecode :: (Typing.InferenceContext -> a -> Either Errors.Error Core.Term)} + _TermCoder = Core.Name "hydra.graph.TermCoder" + _TermCoder_type = Core.Name "type" + _TermCoder_encode = Core.Name "encode" + _TermCoder_decode = Core.Name "decode" diff --git a/src/main/haskell/Hydra/Haskell/Lib/Chars.hs b/src/main/haskell/Hydra/Haskell/Lib/Chars.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Chars.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | Haskell implementations of hydra.lib.chars primitives. --- All functions operate on Unicode code points (Int) rather than Char. - -module Hydra.Haskell.Lib.Chars where - -import qualified Data.Char as C - - --- | Check whether a character is alphanumeric. -isAlphaNum :: Int -> Bool -isAlphaNum = C.isAlphaNum . C.chr - --- | Check whether a character is lowercase. -isLower :: Int -> Bool -isLower = C.isLower . C.chr - --- | Check whether a character is a whitespace character. -isSpace :: Int -> Bool -isSpace = C.isSpace . C.chr - --- | Check whether a character is uppercase. -isUpper :: Int -> Bool -isUpper = C.isUpper . C.chr - --- | Convert a character to lowercase. -toLower :: Int -> Int -toLower = C.ord . C.toLower . C.chr - --- | Convert a character to uppercase. -toUpper :: Int -> Int -toUpper = C.ord . C.toUpper . C.chr diff --git a/src/main/haskell/Hydra/Haskell/Lib/Eithers.hs b/src/main/haskell/Hydra/Haskell/Lib/Eithers.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Eithers.hs +++ /dev/null @@ -1,69 +0,0 @@ --- | Haskell implementations of hydra.lib.eithers primitives - -module Hydra.Haskell.Lib.Eithers where - -import qualified Control.Monad as CM -import qualified Data.Bifunctor as BF -import qualified Data.Either as E -import qualified Data.Set as S - - --- | Map over both sides of an Either value. -bimap :: (a -> c) -> (b -> d) -> Either a b -> Either c d -bimap = BF.bimap - --- | Bind (flatMap) for Either: if Right, apply the function; if Left, return unchanged. -bind :: Either a b -> (b -> Either a c) -> Either a c -bind = (>>=) - --- | 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 - --- | Check if an Either is a Left value. -isLeft :: Either a b -> Bool -isLeft = E.isLeft - --- | Check if an Either is a Right value. -isRight :: Either a b -> Bool -isRight = E.isRight - --- | Extract all Left values from a list of Eithers. -lefts :: [Either a b] -> [a] -lefts = E.lefts - --- | Map a function over the Right side of an Either (standard functor map). -map :: (a -> b) -> Either c a -> Either c b -map = fmap - --- | Map a function returning Either over a list, collecting results or short-circuiting on Left. -mapList :: (a -> Either c b) -> [a] -> Either c [b] -mapList = CM.mapM - --- | Map a function returning Either over an optional, or return Right Nothing if Nothing. -mapOptional :: (a -> Either c b) -> Maybe a -> Either c (Maybe b) -mapOptional = CM.mapM - --- | Map a function returning Either over a Set, collecting results or short-circuiting on Left. -mapSet :: Ord b => (a -> Either c b) -> S.Set a -> Either c (S.Set b) -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 - --- | Extract all Right values from a list of Eithers. -rights :: [Either a b] -> [b] -rights = E.rights diff --git a/src/main/haskell/Hydra/Haskell/Lib/Equality.hs b/src/main/haskell/Hydra/Haskell/Lib/Equality.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Equality.hs +++ /dev/null @@ -1,47 +0,0 @@ --- | Haskell implementations of hydra.lib.equality primitives. - -module Hydra.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 diff --git a/src/main/haskell/Hydra/Haskell/Lib/Lists.hs b/src/main/haskell/Hydra/Haskell/Lib/Lists.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Lists.hs +++ /dev/null @@ -1,171 +0,0 @@ --- | Haskell implementations of hydra.lib.lists primitives - -module Hydra.Haskell.Lib.Lists where - -import Hydra.Util -import Hydra.Core -import Hydra.Graph -import qualified Hydra.Dsl.Terms as Terms - -import qualified Data.List as L - - --- | Apply a list of functions to a list of values (applicative style). -apply :: [a -> b] -> [a] -> [b] -apply = (<*>) - --- | Apply a function that returns lists to each element and flatten results. -bind :: [a] -> (a -> [b]) -> [b] -bind = (>>=) - --- | Concatenate a list of lists. -concat :: [[a]] -> [a] -concat = L.concat - --- | Concatenate two lists. -concat2 :: [a] -> [a] -> [a] -concat2 l1 l2 = l1 ++ l2 - --- | Prepend a value to a list. -cons :: a -> [a] -> [a] -cons = (:) - --- | Drop the first n elements from a list. -drop :: Int -> [a] -> [a] -drop = L.drop - --- | Drop elements from the beginning of a list while predicate is true. -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 - --- | Find the first element matching a predicate. -find :: (a -> Bool) -> [a] -> Maybe a -find = L.find - --- | 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 --- Hydra.Python.Coder.extendMetaForTerm), causing pathological wallclock --- in the Python coder's gatherMetadata pass. Use foldl' to evaluate --- each accumulator step strictly. -foldl :: (b -> a -> b) -> b -> [a] -> b -foldl = L.foldl' - --- | Fold a list from the right. -foldr :: (a -> b -> b) -> b -> [a] -> b -foldr = L.foldr - --- | Group consecutive equal elements. -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 - --- | Intersperse a value between elements of a list. -intersperse :: a -> [a] -> [a] -intersperse = L.intersperse - --- | Get the length of a list. -length :: [a] -> Int -length = L.length - --- | Map a function over a list. -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 - --- | 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) - --- | 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) - --- | 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 - --- | Remove duplicate elements from a list. -nub :: Eq a => [a] -> [a] -nub = L.nub - --- | Check if a list is empty. -null :: [a] -> Bool -null = L.null - --- | Partition a list into elements that satisfy a predicate and elements that do not. -partition :: (a -> Bool) -> [a] -> ([a], [a]) -partition = L.partition - --- | Create a list with a single element. -pure :: a -> [a] -pure e = [e] - --- | Create a list with n copies of a value. -replicate :: Int -> a -> [a] -replicate = L.replicate - --- | Reverse a list. -reverse :: [a] -> [a] -reverse = L.reverse - --- | Create a single-element list. -singleton :: a -> [a] -singleton e = [e] - --- | Sort a list. -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 - --- | Split a list at the first element where predicate fails. -span :: (a -> Bool) -> [a] -> ([a], [a]) -span = L.span - --- | Take the first n elements from a list. -take :: Int -> [a] -> [a] -take = L.take - --- | Transpose a list of lists. -transpose :: [[a]] -> [[a]] -transpose = L.transpose - --- | Decompose a list into its head and tail, returning Nothing if the list is empty. -uncons :: [a] -> Maybe (a, [a]) -uncons [] = Nothing -uncons (x:xs) = Just (x, xs) - --- | Zip two lists into pairs. -zip :: [a] -> [b] -> [(a, b)] -zip = L.zip - --- | Zip two lists with a combining function. -zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] -zipWith = L.zipWith diff --git a/src/main/haskell/Hydra/Haskell/Lib/Literals.hs b/src/main/haskell/Hydra/Haskell/Lib/Literals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Literals.hs +++ /dev/null @@ -1,273 +0,0 @@ --- | Haskell implementations of hydra.lib.literals primitives - -module Hydra.Haskell.Lib.Literals where - -import Data.Int -import Data.Scientific (Scientific, toRealFloat, fromFloatDigits) -import Text.Read (readMaybe) -import qualified Data.ByteString as B -import qualified Data.ByteString.Base64 as B64 -import qualified Data.Scientific as Sci -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE - --- | Convert a bigint (Integer) to a decimal (Scientific). -bigintToDecimal :: Integer -> Scientific -bigintToDecimal n = Sci.scientific n 0 - --- | Convert a bigint (Integer) to an int8. -bigintToInt8 :: Integer -> Int8 -bigintToInt8 = fromIntegral - --- | Convert a bigint (Integer) to an int16. -bigintToInt16 :: Integer -> Int16 -bigintToInt16 = fromIntegral - --- | Convert a bigint (Integer) to an int32. -bigintToInt32 :: Integer -> Int -bigintToInt32 = fromIntegral - --- | Convert a bigint (Integer) to an int64. -bigintToInt64 :: Integer -> Int64 -bigintToInt64 = fromIntegral - --- | Convert a bigint (Integer) to a uint8. -bigintToUint8 :: Integer -> Int16 -bigintToUint8 = fromIntegral - --- | Convert a bigint (Integer) to a uint16. -bigintToUint16 :: Integer -> Int -bigintToUint16 = fromIntegral - --- | Convert a bigint (Integer) to a uint32. -bigintToUint32 :: Integer -> Int64 -bigintToUint32 = fromIntegral - --- | Convert a bigint (Integer) to a uint64. -bigintToUint64 :: Integer -> Integer -bigintToUint64 = id - --- | Convert binary to a list of byte values (0-255). -binaryToBytes :: B.ByteString -> [Int] -binaryToBytes = fmap fromIntegral . B.unpack - --- | Convert a decimal (Scientific) to a bigint (Integer) using banker's rounding --- (round half to even), matching Haskell's 'round' and the BigDecimal/BigInt behavior --- in the other Hydra hosts. -decimalToBigint :: Scientific -> Integer -decimalToBigint = round - --- | Convert a decimal (Scientific) to a float32 (Float). May lose precision. -decimalToFloat32 :: Scientific -> Float -decimalToFloat32 = toRealFloat - --- | Convert a decimal (Scientific) to a float64 (Double). May lose precision. -decimalToFloat64 :: Scientific -> Double -decimalToFloat64 = toRealFloat - --- | Convert binary to string by base64 encoding. -binaryToString :: B.ByteString -> String -binaryToString = T.unpack . TE.decodeUtf8 . B64.encode - --- | Convert a float32 (Float) to a decimal (Scientific). -float32ToDecimal :: Float -> Scientific -float32ToDecimal = fromFloatDigits - --- | Convert a float32 (Float) to a float64 (Double). --- Preserves IEEE special values (NaN, +/-Infinity); plain realToFrac --- routes through Rational and collapses Inf to maxFinite (~3.4028e38). -float32ToFloat64 :: Float -> Double -float32ToFloat64 x - | isNaN x = 0/0 - | isInfinite x = if x < 0 then -1/0 else 1/0 - | otherwise = realToFrac x - --- | Convert a float64 (Double) to a decimal (Scientific). -float64ToDecimal :: Double -> Scientific -float64ToDecimal = fromFloatDigits - --- | Convert a float64 (Double) to a float32 (Float). May lose precision. --- IEEE special values are preserved; for finite values, realToFrac --- (which converts via Rational) is used. -float64ToFloat32 :: Double -> Float -float64ToFloat32 x - | isNaN x = 0/0 - | isInfinite x = if x < 0 then -1/0 else 1/0 - | otherwise = realToFrac x - --- | Convert an int8 to a bigint (Integer). -int8ToBigint :: Int8 -> Integer -int8ToBigint = fromIntegral - --- | Convert an int16 to a bigint (Integer). -int16ToBigint :: Int16 -> Integer -int16ToBigint = fromIntegral - --- | Convert an int32 to a bigint (Integer). -int32ToBigint :: Int -> Integer -int32ToBigint = fromIntegral - --- | Convert an int64 to a bigint (Integer). -int64ToBigint :: Int64 -> Integer -int64ToBigint = fromIntegral - --- | Parse a string to a bigint (Integer). -readBigint :: String -> Maybe Integer -readBigint s = readMaybe s :: Maybe Integer - --- | Parse a string to a boolean. -readBoolean :: String -> Maybe Bool -readBoolean s = if s == "true" then Just True - else if s == "false" then Just False - else Nothing - --- | Parse a string to a decimal (Scientific). -readDecimal :: String -> Maybe Scientific -readDecimal s = readMaybe s :: Maybe Scientific - --- | Parse a string to a float32 (Float). -readFloat32 :: String -> Maybe Float -readFloat32 s = readMaybe s :: Maybe Float - --- | Parse a string to a float64 (Double). -readFloat64 :: String -> Maybe Double -readFloat64 s = readMaybe s :: Maybe Double - --- | Parse a string to an int8 (-128 to 127). -readInt8 :: String -> Maybe Int8 -readInt8 s = do - n <- readMaybe s :: Maybe Integer - if n >= -128 && n <= 127 then Just (fromIntegral n) else Nothing - --- | Parse a string to an int16 (-32768 to 32767). -readInt16 :: String -> Maybe Int16 -readInt16 s = do - n <- readMaybe s :: Maybe Integer - if n >= -32768 && n <= 32767 then Just (fromIntegral n) else Nothing - --- | Parse a string to an int32. -readInt32 :: String -> Maybe Int -readInt32 s = readMaybe s :: Maybe Int - --- | Parse a string to an int64. -readInt64 :: String -> Maybe Int64 -readInt64 s = readMaybe s :: Maybe Int64 - --- | Parse a string literal. -readString :: String -> Maybe String -readString 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 --- The read functions parse as unsigned and validate the range - --- | Parse a string to a uint8 (0 to 255). -readUint8 :: String -> Maybe Int16 -readUint8 s = do - n <- readMaybe s :: Maybe Integer - if n >= 0 && n <= 255 then Just (fromIntegral n) else Nothing - --- | Parse a string to a uint16 (0 to 65535). -readUint16 :: String -> Maybe Int -readUint16 s = do - n <- readMaybe s :: Maybe Integer - if n >= 0 && n <= 65535 then Just (fromIntegral n) else Nothing - --- | Parse a string to a uint32 (0 to 4294967295). -readUint32 :: String -> Maybe Int64 -readUint32 s = do - n <- readMaybe s :: Maybe Integer - if n >= 0 && n <= 4294967295 then Just (fromIntegral n) else Nothing - --- | Parse a string to a uint64 (0 to 18446744073709551615). -readUint64 :: String -> Maybe Integer -readUint64 s = do - n <- readMaybe s :: Maybe Integer - if n >= 0 && n <= 18446744073709551615 then Just n else Nothing - --- | Convert a bigint (Integer) to string. -showBigint :: Integer -> String -showBigint = show - --- | Convert a boolean to string. -showBoolean :: Bool -> String -showBoolean b = case b of - True -> "true" - False -> "false" - --- | Convert a decimal (Scientific) to string. Uses Scientific's default format --- (regular notation for small-magnitude values; scientific notation for very --- large or very small). -showDecimal :: Scientific -> String -showDecimal = show - --- | Convert a float32 (Float) to string. -showFloat32 :: Float -> String -showFloat32 = show - --- | Convert a float64 (Double) to string. -showFloat64 :: Double -> String -showFloat64 = show - --- | Convert an int8 to string. -showInt8 :: Int8 -> String -showInt8 = show - --- | Convert an int16 to string. -showInt16 :: Int16 -> String -showInt16 = show - --- | Convert an int32 to string. -showInt32 :: Int -> String -showInt32 = show - --- | Convert an int64 to string. -showInt64 :: Int64 -> String -showInt64 = show - --- | Convert a string to a quoted string representation. -showString :: String -> String -showString = show - --- | Convert a uint8 to string. -showUint8 :: Int16 -> String -showUint8 = show - --- | Convert a uint16 to string. -showUint16 :: Int -> String -showUint16 = show - --- | Convert a uint32 to string. -showUint32 :: Int64 -> String -showUint32 = show - --- | Convert a uint64 to string. -showUint64 :: Integer -> String -showUint64 = show - --- | 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 - Left _ -> B.empty - Right bs -> bs - --- | Parse a string as a Scientific decimal. Errors on malformed input. -stringToDecimal :: String -> Scientific -stringToDecimal = read - --- | Convert a uint8 to a bigint (Integer). -uint8ToBigint :: Int16 -> Integer -uint8ToBigint = fromIntegral - --- | Convert a uint16 to a bigint (Integer). -uint16ToBigint :: Int -> Integer -uint16ToBigint = fromIntegral - --- | Convert a uint32 to a bigint (Integer). -uint32ToBigint :: Int64 -> Integer -uint32ToBigint = fromIntegral - --- | Convert a uint64 to a bigint (Integer). -uint64ToBigint :: Integer -> Integer -uint64ToBigint = id diff --git a/src/main/haskell/Hydra/Haskell/Lib/Logic.hs b/src/main/haskell/Hydra/Haskell/Lib/Logic.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Logic.hs +++ /dev/null @@ -1,24 +0,0 @@ --- | Haskell implementations of hydra.lib.logic (logic and control flow) primitives - -module Hydra.Haskell.Lib.Logic where - -import Hydra.Core - -import Data.Int - - --- | Compute the logical AND of two boolean values. -and :: Bool -> Bool -> Bool -and x y = x && y - --- | Compute a conditional expression. -ifElse :: Bool -> a -> a -> a -ifElse b x y = if b then x else y - --- | Compute the logical NOT of a boolean value. -not :: Bool -> Bool -not = Prelude.not - --- | Compute the logical OR of two boolean values. -or :: Bool -> Bool -> Bool -or x y = x || y diff --git a/src/main/haskell/Hydra/Haskell/Lib/Maps.hs b/src/main/haskell/Hydra/Haskell/Lib/Maps.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Maps.hs +++ /dev/null @@ -1,86 +0,0 @@ --- | Haskell implementations of hydra.lib.maps primitives - -module Hydra.Haskell.Lib.Maps where - -import qualified Data.Map as M - - --- | Alter a value at a key using a function. -alter :: Ord k => (Maybe v -> Maybe v) -> k -> M.Map k v -> M.Map k v -alter = M.alter - --- | Map a function over the keys and values of a map. -bimap :: (Ord k1, Ord k2) => (k1 -> k2) -> (v1 -> v2) -> M.Map k1 v1 -> M.Map k2 v2 -bimap f g = M.fromList . fmap (\(k, v) -> (f k, g v)) . M.toList - --- | Remove a key from a map. -delete :: Ord k => k -> M.Map k v -> M.Map k v -delete = M.delete - --- | Get the values of a map. -elems :: M.Map k v -> [v] -elems = M.elems - --- | Create an empty map. -empty :: M.Map k v -empty = M.empty - --- | Filter a map based on values. -filter :: Ord k => (v -> Bool) -> M.Map k v -> M.Map k v -filter = M.filter - --- | Filter a map based on key-value pairs. -filterWithKey :: Ord k => (k -> v -> Bool) -> M.Map k v -> M.Map k v -filterWithKey = M.filterWithKey - --- | Lookup a value with a default. -findWithDefault :: Ord k => v -> k -> M.Map k v -> v -findWithDefault = M.findWithDefault - --- | Create a map from a list of key-value pairs. -fromList :: Ord k => [(k, v)] -> M.Map k v -fromList = M.fromList - --- | Insert a key-value pair into a map. -insert :: Ord k => k -> v -> M.Map k v -> M.Map k v -insert = M.insert - --- | Get the keys of a map. -keys :: M.Map k v -> [k] -keys = M.keys - --- | Lookup a value in a map. -lookup :: Ord k => k -> M.Map k v -> Maybe v -lookup = M.lookup - --- | Map a function over a map. -map :: (v1 -> v2) -> M.Map k v1 -> M.Map k v2 -map = fmap - --- | Map a function over the keys of a map. -mapKeys :: (Ord k1, Ord k2) => (k1 -> k2) -> M.Map k1 v -> M.Map k2 v -mapKeys = M.mapKeys - --- | Check if a key is present in a map. -member :: Ord k => k -> M.Map k v -> Bool -member = M.member - --- | Check if a map is empty. -null :: M.Map k v -> Bool -null = M.null - --- | Create a map with a single key-value pair. -singleton :: k -> v -> M.Map k v -singleton = M.singleton - --- | Get the size of a map. -size :: M.Map k v -> Int -size = M.size - --- | Convert a map to a list of key-value pairs. -toList :: M.Map k v -> [(k, v)] -toList = M.toList - --- | 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 diff --git a/src/main/haskell/Hydra/Haskell/Lib/Math.hs b/src/main/haskell/Hydra/Haskell/Lib/Math.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Math.hs +++ /dev/null @@ -1,234 +0,0 @@ --- | Haskell implementations of hydra.lib.math primitives - -module Hydra.Haskell.Lib.Math where - -import Prelude (Num, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), (.), ($), (+), (-), (*), (==), (||)) -import qualified Prelude - - --- | Return the absolute value. -abs :: Num a => a -> a -abs = Prelude.abs - --- | Return the arc cosine of x in radians. -acos :: Double -> Double -acos = Prelude.acos - --- | Return the inverse hyperbolic cosine of x. -acosh :: Double -> Double -acosh = Prelude.acosh - --- | Add two numbers. -add :: Num a => a -> a -> a -add x y = x + y - --- | Add two Float64 numbers. -addFloat64 :: Double -> Double -> Double -addFloat64 = add - --- | Return the arc sine of x in radians. -asin :: Double -> Double -asin = Prelude.asin - --- | Return the inverse hyperbolic sine of x. -asinh :: Double -> Double -asinh = Prelude.asinh - --- | Return the arc tangent of x in radians. -atan :: Double -> Double -atan = Prelude.atan - --- | Return the arc tangent of y/x in radians, using signs to determine quadrant. -atan2 :: Double -> Double -> Double -atan2 = Prelude.atan2 - --- | Return the inverse hyperbolic tangent of x. -atanh :: Double -> Double -atanh = Prelude.atanh - --- | Return the ceiling of x as a float. --- --- DIVERGENCE FROM HASKELL: Haskell's Prelude.ceiling returns an Integer, which --- cannot represent NaN or Inf; GHC's behavior on those inputs is undefined and --- produces nonsensical gigantic integers. Hydra returns a Float64 instead so --- that NaN and ±Inf propagate naturally per IEEE 754, matching the conventions --- of C (ceil), Java (Math.ceil), Go (math.Ceil), Rust (f64::ceil), and JavaScript --- (Math.ceil). Users who need an Integer value must convert explicitly. -ceiling :: Double -> Double -ceiling x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | Prelude.otherwise = Prelude.fromIntegral (Prelude.ceiling x :: Integer) - --- | Return the cosine of x radians. -cos :: Double -> Double -cos = Prelude.cos - --- | Return the hyperbolic cosine of x. -cosh :: Double -> Double -cosh = Prelude.cosh - --- | Euler's number (e ≈ 2.71828). -e :: Double -e = Prelude.exp 1.0 - --- | Check if an integer is even. -even :: Integral a => a -> Bool -even = Prelude.even - --- | Return e raised to the power x. -exp :: Double -> Double -exp = Prelude.exp - --- | Return the floor of x as a float. --- --- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than --- Integer so that NaN and ±Inf propagate naturally per IEEE 754. -floor :: Double -> Double -floor x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | Prelude.otherwise = Prelude.fromIntegral (Prelude.floor x :: Integer) - --- | Return the natural logarithm of x. -log :: Double -> Double -log = Prelude.log - --- | Return the logarithm of x to the given base. -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 - --- | Mathematical modulo, returning Nothing on division by zero. -maybeMod :: Int -> Int -> Maybe Int -maybeMod _ 0 = Nothing -maybeMod x y = Just (Prelude.mod x y) - --- | Multiply two numbers. -mul :: Num a => a -> a -> a -mul x y = x * y - --- | Multiply two Float64 numbers. -mulFloat64 :: Double -> Double -> Double -mulFloat64 = mul - --- | Negate a number. -negate :: Num a => a -> a -negate = Prelude.negate - --- | Negate a Float64 number. -negateFloat64 :: Double -> Double -negateFloat64 = Prelude.negate - --- | Check if an integer is odd. -odd :: Integral a => a -> Bool -odd = Prelude.odd - --- | Pi (π ≈ 3.14159). -pi :: Double -pi = Prelude.pi - --- | Return x raised to the power y. -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) - --- | Return x rounded to the nearest integer, as a float. --- --- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than --- Integer so that NaN and ±Inf propagate naturally per IEEE 754. -round :: Double -> Double -round x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | Prelude.otherwise = Prelude.fromIntegral (Prelude.round x :: Integer) - --- | Round a float32 to n significant digits. --- Returns NaN/Inf inputs unchanged (no rounding is possible). -roundFloat32 :: Int -> Float -> Float -roundFloat32 n x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | x Prelude.== 0 = 0 - | Prelude.otherwise = - let factor = 10 Prelude.^^ (n - 1 - Prelude.floor (Prelude.logBase 10 (Prelude.abs x))) - in Prelude.fromIntegral (Prelude.round (x * factor) :: Integer) Prelude./ factor - --- | Round a float64 to n significant digits. --- Returns NaN/Inf inputs unchanged (no rounding is possible). -roundFloat64 :: Int -> Double -> Double -roundFloat64 n x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | x Prelude.== 0 = 0 - | Prelude.otherwise = - let factor = 10 Prelude.^^ (n - 1 - Prelude.floor (Prelude.logBase 10 (Prelude.abs x))) - in Prelude.fromIntegral (Prelude.round (x * factor) :: Integer) Prelude./ factor - --- | Return the sign of a number (-1, 0, or 1). -signum :: Num a => a -> a -signum = Prelude.signum - --- | Return the sine of x radians. -sin :: Double -> Double -sin = Prelude.sin - --- | Return the hyperbolic sine of x. -sinh :: Double -> Double -sinh = Prelude.sinh - --- | Return the square root of x. -sqrt :: Double -> Double -sqrt = Prelude.sqrt - --- | Subtract two numbers. -sub :: Num a => a -> a -> a -sub x y = x - y - --- | Subtract two Float64 numbers. -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 -tan = Prelude.tan - --- | Return the hyperbolic tangent of x. -tanh :: Double -> Double -tanh = Prelude.tanh - --- | Return x truncated (towards zero), as a float. --- --- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than --- Integer so that NaN and ±Inf propagate naturally per IEEE 754. -truncate :: Double -> Double -truncate x - | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x - | Prelude.otherwise = Prelude.fromIntegral (Prelude.truncate x :: Integer) diff --git a/src/main/haskell/Hydra/Haskell/Lib/Optionals.hs b/src/main/haskell/Hydra/Haskell/Lib/Optionals.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Optionals.hs +++ /dev/null @@ -1,54 +0,0 @@ --- | Haskell implementations of hydra.lib.optionals primitives - -module Hydra.Haskell.Lib.Optionals where - -import qualified Data.Maybe as Y - - --- | Apply a function to an argument (applicative). -apply :: Y.Maybe (a -> b) -> Y.Maybe a -> Y.Maybe b -apply = (<*>) - --- | Chain operations on optional values, handling absent cases automatically. -bind :: Y.Maybe a -> (a -> Y.Maybe b) -> Y.Maybe b -bind = (>>=) - --- | Handle an optional value with the absent-case value as the first argument. -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 - --- | Check if a value is present. -isGiven :: Y.Maybe a -> Bool -isGiven = Y.isJust - --- | Check if a value is absent. -isNone :: Y.Maybe a -> Bool -isNone = Y.isNothing - --- | Map a function over an optional value. -map :: (a -> b) -> Y.Maybe a -> Y.Maybe b -map = fmap - --- | Map a function over a list and collect present results. -mapOptional :: (a -> Y.Maybe b) -> [a] -> [b] -mapOptional = Y.mapMaybe - --- | Lift a value into the optional type. -pure :: a -> Y.Maybe a -pure = Just - --- | Convert an optional value to a list: a present value becomes [x], an absent value becomes []. -toList :: Y.Maybe a -> [a] -toList = Y.maybeToList diff --git a/src/main/haskell/Hydra/Haskell/Lib/Pairs.hs b/src/main/haskell/Hydra/Haskell/Lib/Pairs.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Pairs.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Haskell implementations of hydra.lib.pairs primitives - -module Hydra.Haskell.Lib.Pairs where - -import qualified Data.Bifunctor as BF - - --- | Map over both elements of a pair. -bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d) -bimap = BF.bimap - --- | Get the first element of a pair. -first :: (a, b) -> a -first (x, _) = x - --- | Get the second element of a pair. -second :: (a, b) -> b -second (_, y) = y diff --git a/src/main/haskell/Hydra/Haskell/Lib/Regex.hs b/src/main/haskell/Hydra/Haskell/Lib/Regex.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Regex.hs +++ /dev/null @@ -1,48 +0,0 @@ --- | Haskell implementations of hydra.lib.regex primitives - -module Hydra.Haskell.Lib.Regex where - -import qualified Text.Regex.TDFA as R - - --- | Find the first substring matching a regex pattern. -find :: String -> String -> Maybe String -find pattern input = case (input R.=~ pattern :: (String, String, String)) of - (_, match, _) - | null match -> Nothing - | otherwise -> Just match - --- | Find all non-overlapping substrings matching a regex pattern. -findAll :: String -> String -> [String] -findAll pattern input = R.getAllTextMatches (input R.=~ pattern :: R.AllTextMatches [] String) - --- | Check whether an entire string matches a regex pattern. -matches :: String -> String -> Bool -matches pattern input = input R.=~ ("^(" ++ pattern ++ ")$" :: String) :: Bool - --- | Replace the first occurrence of a regex pattern with a replacement string. -replace :: String -> String -> String -> String -replace pattern replacement input = case (input R.=~ pattern :: (String, String, String)) of - (before, match, after) - | null match -> input - | otherwise -> before ++ replacement ++ after - --- | Replace all non-overlapping occurrences of a regex pattern with a replacement string. -replaceAll :: String -> String -> String -> String -replaceAll pattern replacement input = go input - where - go "" = "" - go s = case (s R.=~ pattern :: (String, String, String)) of - (before, match, after) - | null match -> s - | otherwise -> before ++ replacement ++ go after - --- | Split a string by a regex pattern. -split :: String -> String -> [String] -split pattern input = go input - where - go "" = [""] - go s = case (s R.=~ pattern :: (String, String, String)) of - (before, match, after) - | null match -> [s] - | otherwise -> before : go after diff --git a/src/main/haskell/Hydra/Haskell/Lib/Sets.hs b/src/main/haskell/Hydra/Haskell/Lib/Sets.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Sets.hs +++ /dev/null @@ -1,64 +0,0 @@ --- | Haskell implementations of hydra.lib.sets primitives - -module Hydra.Haskell.Lib.Sets where - -import qualified Data.Set as S - - --- | Delete an element from a set. -delete :: Ord x => x -> S.Set x -> S.Set x -delete = S.delete - --- | Compute the difference of two sets. -difference :: Ord x => S.Set x -> S.Set x -> S.Set x -difference = S.difference - --- | Create an empty set. -empty :: S.Set x -empty = S.empty - --- | Create a set from a list. -fromList :: Ord x => [x] -> S.Set x -fromList = S.fromList - --- | Insert an element into a set. -insert :: Ord x => x -> S.Set x -> S.Set x -insert = S.insert - --- | Compute the intersection of two sets. -intersection :: Ord x => S.Set x -> S.Set x -> S.Set x -intersection = S.intersection - --- | Map a function over a set. --- Note: the presence of a 'map' function does not imply that sets are a functor in Hydra -map :: Ord y => (x -> y) -> S.Set x -> S.Set y -map f = S.fromList . fmap f . S.toList - --- | Check if an element is in a set. -member :: Ord x => x -> S.Set x -> Bool -member = S.member - --- | Check if a set is empty. -null :: S.Set x -> Bool -null = S.null - --- | Create a singleton set. --- Consider renaming this to Sets.pure, or creating an alias -singleton :: x -> S.Set x -singleton = S.singleton - --- | Get the size of a set. -size :: S.Set x -> Int -size = S.size - --- | Convert a set to a list. -toList :: Ord x => S.Set x -> [x] -toList = S.toList - --- | Compute the union of two sets. -union :: Ord x => S.Set x -> S.Set x -> S.Set x -union = S.union - --- | Compute the union of multiple sets. -unions :: Ord x => [S.Set x] -> S.Set x -unions = S.unions diff --git a/src/main/haskell/Hydra/Haskell/Lib/Strings.hs b/src/main/haskell/Hydra/Haskell/Lib/Strings.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Haskell/Lib/Strings.hs +++ /dev/null @@ -1,62 +0,0 @@ --- | Haskell implementations of hydra.lib.strings primitives - -module Hydra.Haskell.Lib.Strings where - -import qualified Data.Char as C -import qualified Data.List as L -import qualified Data.List.Split as LS - - --- | Concatenate a list of strings into a single string. -cat :: [String] -> String -cat = L.concat - --- | Concatenate two strings. -cat2 :: String -> String -> String -cat2 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 - --- | 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] -lines = L.lines - --- | Check whether a string is empty. -null :: String -> Bool -null = L.null - --- | Split a string on a delimiter string. -splitOn :: String -> String -> [String] -splitOn = LS.splitOn - --- | Convert a string to a list of Unicode code points. -toList :: String -> [Int] -toList = fmap C.ord - --- | Convert a string to lowercase. -toLower :: String -> String -toLower = fmap C.toLower - --- | Convert a string to uppercase. -toUpper :: String -> String -toUpper = fmap C.toUpper - --- | Join a list of strings with newlines, appending a trailing newline. -unlines :: [String] -> String -unlines = L.unlines 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 @@ -1,28 +1,34 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for deep term rewriting operations involving hoisting subterms or bindings into enclosing let terms. module Hydra.Hoisting 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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.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 @@ -34,8 +40,10 @@ import qualified Hydra.Sorting as Sorting 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 @@ -46,6 +54,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | Augment bindings with new free variables introduced by substitution, wrapping with lambdas after any type lambdas. augmentBindingsWithNewFreeVars :: Graph.Graph -> S.Set Core.Name -> [Core.Binding] -> ([Core.Binding], Typing.TermSubst) augmentBindingsWithNewFreeVars cx boundVars bindings = @@ -82,10 +91,12 @@ 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))))) + -- | Check if a binding has a polymorphic type (non-empty list of type scheme variables) bindingIsPolymorphic :: Core.Binding -> Bool bindingIsPolymorphic binding = Optionals.cases (Core.bindingTypeScheme binding) False (\ts -> Logic.not (Lists.null (Core.typeSchemeVariables ts))) + -- | Check if a binding's type uses any type variables from the given Graph. Returns True if the free type variables in the binding's type intersect with the type variables in scope (graphTypeVariables). bindingUsesContextTypeVars :: Graph.Graph -> Core.Binding -> Bool bindingUsesContextTypeVars cx binding = @@ -93,6 +104,7 @@ let freeInType = Variables.freeVariablesInType (Core.typeSchemeBody ts) contextTypeVars = Graph.graphTypeVariables cx in (Logic.not (Sets.null (Sets.intersection freeInType contextTypeVars)))) + -- | Count the number of occurrences of a variable name in a term. Assumes no variable shadowing. countVarOccurrences :: Core.Name -> Core.Term -> Int countVarOccurrences name term = @@ -101,6 +113,7 @@ in case term of Core.TermVariable v0 -> Logic.ifElse (Equality.equal v0 name) (Math.add 1 childCount) childCount _ -> childCount + -- | Transform a let-term by pulling ALL let bindings to the top level. This is useful for targets like Java that don't support nested let expressions at all. If a hoisted binding captures lambda-bound variables from an enclosing scope, the binding is wrapped in lambdas for those variables, and references are replaced with applications. Note: Assumes no variable shadowing; use hydra.rewriting.unshadowVariables first. hoistAllLetBindings :: Core.Let -> Core.Let hoistAllLetBindings let0 = @@ -116,9 +129,11 @@ Graph.graphSchemaTypes = Maps.empty, Graph.graphTypeVariables = Sets.empty} in (hoistLetBindingsWithPredicate (\_ -> True) shouldHoistAll emptyCx let0) + -- | Hoist case statements into local let bindings. This is useful for targets such as Python which only support case statements (match) at the top level. Case statements are hoisted only when they appear at non-top-level positions. Top level = root, or reachable through annotations, let body/binding, lambda bodies, or ONE application LHS. Once through an application LHS, lambda bodies no longer count as pass-through. hoistCaseStatements :: Graph.Graph -> Core.Term -> Core.Term hoistCaseStatements = hoistSubterms shouldHoistCaseStatement + -- | Hoist case statements into local let bindings for a list of bindings. This version operates prior to inference and uses an empty type context. It hoists case statements and their applied arguments into let bindings. hoistCaseStatementsInGraph :: [Core.Binding] -> [Core.Binding] hoistCaseStatementsInGraph bindings = @@ -139,10 +154,12 @@ Core.letBody = Core.TermUnit}) term1 = hoistCaseStatements emptyTx term0 in (Environment.termAsBindings term1) + -- | Transform a let-term by pulling polymorphic let bindings to the top level, using Graph. A binding is hoisted if: (1) It is polymorphic (has non-empty typeSchemeVariables), OR (2) Its type uses type variables from the Graph (i.e., from enclosing type lambdas). Bindings which are already at the top level are not hoisted. If a hoisted binding captures lambda-bound or let-bound variables from an enclosing scope, the binding is wrapped in lambdas for those variables, and references are replaced with applications. If a hoisted binding uses type variables from the context, those type variables are added to the binding's type scheme. Note: we assume that there is no variable shadowing; use hydra.rewriting.unshadowVariables first. hoistLetBindingsWithContext :: (Core.Binding -> Bool) -> Graph.Graph -> Core.Let -> Core.Let hoistLetBindingsWithContext isParentBinding cx let0 = hoistLetBindingsWithPredicate isParentBinding shouldHoistPolymorphic cx let0 + -- | Transform a let-term by pulling let bindings to the top level. The isParentBinding predicate applies to top-level bindings and determines whether their subterm bindings are eligible for hoisting. The shouldHoistBinding predicate takes the Graph and a subterm binding, and returns True if the binding should be hoisted. This is useful for targets like Java that cannot have polymorphic definitions in arbitrary positions. The Graph provides information about type variables and lambda variables in scope. If a hoisted binding captures let-bound or lambda-bound variables from an enclosing scope, the binding is wrapped in lambdas for those variables, and references are replaced with applications. If a hoisted binding captures type variables from an enclosing type lambda scope, those type variables are added to the binding's type scheme, and references are replaced with type applications. Note: we assume that there is no variable shadowing; use hydra.rewriting.unshadowVariables first. hoistLetBindingsWithPredicate :: (Core.Binding -> Bool) -> (Graph.Graph -> Core.Binding -> Bool) -> Graph.Graph -> Core.Let -> Core.Let hoistLetBindingsWithPredicate isParentBinding shouldHoistBinding cx0 let0 = @@ -298,6 +315,7 @@ in Core.Let { Core.letBindings = (Lists.concat (Lists.map forBinding (Core.letBindings let0))), Core.letBody = (Core.letBody let0)} + -- | Transform a let-term by pulling all polymorphic let bindings to the top level. This is useful to ensure that polymorphic bindings are not nested within other terms, which is unsupported by certain targets such as Java. Polymorphic bindings are those with a non-empty list of type scheme variables. If a hoisted binding captures lambda-bound variables from an enclosing scope, the binding is wrapped in lambdas for those variables, and references are replaced with applications. Note: Assumes no variable shadowing; use hydra.rewriting.unshadowVariables first. hoistPolymorphicLetBindings :: (Core.Binding -> Bool) -> Core.Let -> Core.Let hoistPolymorphicLetBindings isParentBinding let0 = @@ -313,6 +331,7 @@ Graph.graphSchemaTypes = Maps.empty, Graph.graphTypeVariables = Sets.empty} in (hoistLetBindingsWithPredicate isParentBinding shouldHoistPolymorphic emptyCx let0) + -- | Hoist subterms into local let bindings based on a path-aware predicate. The predicate receives a pair of (path, term) where path is the list of SubtermSteps from the root to the current term, and returns True if the term should be hoisted. For each let term found, the immediate subterms (binding values and body) are processed: matching subterms within each immediate subterm are collected and hoisted into a local let that wraps that immediate subterm. If a hoisted term contains free variables that are lambda-bound at an enclosing scope, the hoisted binding is wrapped in lambdas for those variables, and the reference is replaced with an application of those variables. hoistSubterms :: (([Paths.SubtermStep], Core.Term) -> Bool) -> Graph.Graph -> Core.Term -> Core.Term hoistSubterms shouldHoist cx0 term0 = @@ -418,30 +437,35 @@ _ -> (newCounter, recursedTerm) _ -> recurse counter term in (Pairs.second (Rewriting.rewriteAndFoldTermWithGraphAndPath rewrite cx0 1 term0)) + -- | Check whether a SubtermStep is the applicationFunction step isApplicationFunction :: Paths.SubtermStep -> Bool isApplicationFunction acc = case acc of Paths.SubtermStepApplicationFunction -> True _ -> False + -- | Check whether a SubtermStep is the lambdaBody step isLambdaBody :: Paths.SubtermStep -> Bool isLambdaBody acc = case acc of Paths.SubtermStepLambdaBody -> True _ -> False + -- | Check if a term is a union elimination (case statement) isUnionElimination :: Core.Term -> Bool isUnionElimination term = case term of Core.TermCases _ -> True _ -> False + -- | Check if a term is an application of a union elimination (case statement applied to an argument) isUnionEliminationApplication :: Core.Term -> Bool isUnionEliminationApplication term = case term of Core.TermApplication v0 -> isUnionElimination (Strip.deannotateAndDetypeTerm (Core.applicationFunction v0)) _ -> False + -- | Normalize a path for hoisting by treating immediately-applied lambdas as let bindings. Replaces [applicationFunction, lambdaBody, ...] with [letBody, ...]. normalizePathForHoisting :: [Paths.SubtermStep] -> [Paths.SubtermStep] normalizePathForHoisting path = @@ -455,9 +479,11 @@ rest = Pairs.second uc2 in (Logic.ifElse (Logic.and (isApplicationFunction first) (isLambdaBody second)) (Lists.cons Paths.SubtermStepLetBody (go rest)) (Lists.cons first (go afterFirst)))))) in (go path) + -- | Predicate that always returns True, for hoisting all bindings unconditionally. shouldHoistAll :: t0 -> t1 -> Bool shouldHoistAll _ _2 = True + -- | Predicate for case statement hoisting. Returns True if term is a union elimination (bare case function) or a case statement application (union elimination applied to an argument) AND not at top level. Top level = reachable through annotations, let body/binding, lambda bodies, or ONE app LHS. Once through an app LHS, lambda bodies no longer pass through. shouldHoistCaseStatement :: ([Paths.SubtermStep], Core.Term) -> Bool shouldHoistCaseStatement pathAndTerm = @@ -467,9 +493,11 @@ in (Logic.ifElse (Logic.not (Logic.or (isUnionElimination term) (isUnionEliminationApplication term))) False ( let finalState = Lists.foldl (\st -> \acc -> updateHoistState acc st) (True, False) path in (Logic.not (Pairs.first finalState)))) + -- | Predicate for hoisting polymorphic bindings. Returns True if the binding is polymorphic (has type scheme variables) or if its type uses any type variables from the Graph. shouldHoistPolymorphic :: Graph.Graph -> Core.Binding -> Bool shouldHoistPolymorphic cx binding = Logic.or (bindingIsPolymorphic binding) (bindingUsesContextTypeVars cx binding) + -- | Update hoisting state when traversing an accessor. State is (atTopLevel, usedAppLHS). Returns updated state. updateHoistState :: Paths.SubtermStep -> (Bool, Bool) -> (Bool, Bool) updateHoistState accessor state = 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 @@ -1,31 +1,37 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Type inference for Hydra: Hindley-Milner with elaboration to System F. Extends textbook Algorithm W with nominal types, explicit type abstraction and application, and class constraints. See the Inference wiki page for the full picture. module Hydra.Inference where + import qualified Hydra.Annotations as Annotations 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.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.Json.Model as Model import qualified Hydra.Lexical as Lexical -import qualified Hydra.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -41,8 +47,10 @@ 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 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 @@ -55,16 +63,19 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | 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) + -- | Unify type constraints and check the substitution bindConstraints :: Typing.InferenceContext -> Graph.Graph -> [Typing.TypeConstraint] -> Either Errors.Error Typing.TypeSubst bindConstraints flowCx cx constraints = Eithers.bind (Eithers.bimap (\_e -> Errors.ErrorInference (Errors.InferenceErrorUnification (Errors.UnificationInferenceError { Errors.unificationInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace flowCx))), Errors.unificationInferenceErrorCause = _e}))) (\_a -> _a) (Unification.unifyTypeConstraints flowCx (Graph.graphSchemaTypes cx) constraints)) (\s -> Eithers.bind (Checking.checkTypeSubst flowCx cx s) (\_ -> Right s)) + -- | Handle unbound type variables under a typed let binding. Variables appearing free in the binding's declared type (but not in schema types or the scheme's own quantified variables) are added to the scheme and the term is wrapped in matching TypeLambdas. Variables appearing only in the term body (at type-application or lambda-domain positions) are phantom — they have no external effect on the binding's type — and are substituted with hydra.core.Unit in the body rather than generalized. This keeps downstream stages from seeing vacuous foralls that target languages with non-polymorphic value bindings (e.g. Scala val) cannot express. bindUnboundTypeVariables :: Graph.Graph -> Core.Term -> Core.Term bindUnboundTypeVariables cx term0 = @@ -106,12 +117,14 @@ Core.letBody = (bindUnboundTypeVariables cx (Core.letBody v0))})) _ -> recurse term in (Rewriting.rewriteTerm rewrite term0) + -- | Fold a list of type variables over a term to build a type application term buildTypeApplicationTerm :: [Core.Name] -> Core.Term -> Core.Term buildTypeApplicationTerm tvars body = Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypeApplicationTerm { Core.typeApplicationTermBody = t, Core.typeApplicationTermType = (Core.TypeVariable v)})) body tvars + -- | Add (term variable, type scheme) pairs to the graph's bound types extendContext :: [(Core.Name, Core.TypeScheme)] -> Graph.Graph -> Graph.Graph extendContext pairs cx = @@ -124,20 +137,24 @@ Graph.graphPrimitives = (Graph.graphPrimitives cx), Graph.graphSchemaTypes = (Graph.graphSchemaTypes cx), Graph.graphTypeVariables = (Graph.graphTypeVariables cx)} + -- | Finalize an inferred term by checking for unbound type variables, then normalizing type variables finalizeInferredTerm :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term finalizeInferredTerm flowCx cx term = let term2 = bindUnboundTypeVariables cx term in (Eithers.bind (Checking.checkForUnboundTypeVariables flowCx cx term2) (\_ -> Right (Variables.normalizeTypeVariablesInTerm term2))) + -- | Infer a term's type and map over the result forInferredTerm :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> String -> (Typing.InferenceResult -> t0) -> Either Errors.Error (t0, Typing.InferenceContext) forInferredTerm fcx cx term desc f = Eithers.bind (inferTypeOfTerm fcx cx term desc) (\rp -> Right (f rp, (Typing.inferenceResultContext rp))) + -- | Get all free variables in a graph's bound types freeVariablesInContext :: Graph.Graph -> S.Set Core.Name freeVariablesInContext cx = Lists.foldl Sets.union Sets.empty (Lists.map Variables.freeVariablesInTypeSchemeSimple (Maps.elems (Graph.graphBoundTypes cx))) + -- | Generate a fresh type variable freshVariableType :: Typing.InferenceContext -> (Core.Type, Typing.InferenceContext) freshVariableType cx = @@ -146,6 +163,7 @@ name = Pairs.first result cx2 = Pairs.second result in (Core.TypeVariable name, cx2) + -- | Generalize a type to a type scheme generalize :: Graph.Graph -> Core.Type -> Core.TypeScheme generalize cx typ = @@ -164,10 +182,12 @@ Core.typeSchemeVariables = vars, Core.typeSchemeBody = typ, Core.typeSchemeConstraints = constraintsMaybe} + -- | 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) + -- | Infer types for all elements in a graph, using the provided ordered bindings. Returns both the inferred graph and the ordered inferred bindings. inferGraphTypes :: Typing.InferenceContext -> [Core.Binding] -> Graph.Graph -> Either Errors.Error ((Graph.Graph, [Core.Binding]), Typing.InferenceContext) inferGraphTypes fcx0 bindings0 g0 = @@ -202,9 +222,11 @@ Core.TermVariable _ -> Left (Errors.ErrorInference (Errors.InferenceErrorOther (Errors.OtherInferenceError { Errors.otherInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace fcx2))), Errors.otherInferenceErrorMessage = "Expected inferred graph as let term"}))))))) + -- | Infer the type of a term in a given inference context inferInGraphContext :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error Typing.InferenceResult inferInGraphContext fcx cx term = inferTypeOfTerm fcx cx term "single term" + -- | Infer types for multiple terms, propagating class constraints from sub-expressions inferMany :: Typing.InferenceContext -> Graph.Graph -> [(Core.Term, String)] -> Either Errors.Error ( ([Core.Term], ([Core.Type], (Typing.TypeSubst, (M.Map Core.Name Core.TypeVariableConstraints)))), @@ -237,6 +259,7 @@ Lists.cons (Substitution.substTypesInTerm s2 e1) e2, (Lists.cons (Substitution.substInType s2 t1) t2, (Substitution.composeTypeSubst s1 s2, mergedConstraints))), fcx3)))))))) + -- | Map a possibly untyped term to a fully typed term and its type inferTypeOf :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error ((Core.Term, Core.TypeScheme), Typing.InferenceContext) inferTypeOf fcx cx term = @@ -264,6 +287,7 @@ "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) inferTypeOfAnnotatedTerm :: Typing.InferenceContext -> Graph.Graph -> Core.AnnotatedTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfAnnotatedTerm fcx cx at = @@ -285,6 +309,7 @@ Typing.inferenceResultSubst = isubst, Typing.inferenceResultClassConstraints = iconstraints, Typing.inferenceResultContext = fcx2})))) + -- | Infer the type of a function application (Either version) inferTypeOfApplication :: Typing.InferenceContext -> Graph.Graph -> Core.Application -> Either Errors.Error Typing.InferenceResult inferTypeOfApplication fcx0 cx app = @@ -332,6 +357,7 @@ Typing.inferenceResultSubst = rSubst, Typing.inferenceResultClassConstraints = rConstraints, Typing.inferenceResultContext = fcx4}))))))))) + -- | Infer the type of a case statement (Either version) inferTypeOfCaseStatement :: Typing.InferenceContext -> Graph.Graph -> Core.CaseStatement -> Either Errors.Error Typing.InferenceResult inferTypeOfCaseStatement fcx cx caseStmt = @@ -400,6 +426,7 @@ subst]])) (Substitution.substInClassConstraints subst allElemConstraints)) (Lists.concat [ 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. 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 = @@ -431,6 +458,7 @@ itype = typCons (Core.TypeVariable var) 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) inferTypeOfEither :: Typing.InferenceContext -> Graph.Graph -> Either Core.Term Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfEither fcx cx e = @@ -477,6 +505,7 @@ Core.eitherTypeLeft = leftType, Core.eitherTypeRight = rightType}) in (Right (yieldChecked fcx3 termWithBothTypes eitherType subst)))) e + -- | Infer the type of a union injection (Either version) inferTypeOfInjection :: Typing.InferenceContext -> Graph.Graph -> Core.Injection -> Either Errors.Error Typing.InferenceResult inferTypeOfInjection fcx cx injection = @@ -505,6 +534,7 @@ Typing.typeConstraintLeft = ftyp, Typing.typeConstraintRight = ityp, Typing.typeConstraintComment = "schema type of injected field"}]) (\mcResult -> Right mcResult)))))))) + -- | Infer the type of a lambda function (Either version) inferTypeOfLambda :: Typing.InferenceContext -> Graph.Graph -> Core.Lambda -> Either Errors.Error Typing.InferenceResult inferTypeOfLambda fcx cx lambda = @@ -552,6 +582,7 @@ Typing.inferenceResultSubst = isubst, 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. inferTypeOfLet :: Typing.InferenceContext -> Graph.Graph -> Core.Let -> Either Errors.Error Typing.InferenceResult inferTypeOfLet fcx0 cx let0 = @@ -612,6 +643,7 @@ Core.TermLet v0 -> inferTypeOfLetNormalized fcx cx v0 _ -> 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) inferTypeOfLetNormalized :: Typing.InferenceContext -> Graph.Graph -> Core.Let -> Either Errors.Error Typing.InferenceResult inferTypeOfLetNormalized fcx0 cx0 letTerm = @@ -701,10 +733,12 @@ sbody]), Typing.inferenceResultClassConstraints = allConstraints, Typing.inferenceResultContext = fcx4}))))))))) + -- | Infer the type of a list (Either version) 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 inferTypeOfLiteral :: Typing.InferenceContext -> Core.Literal -> Typing.InferenceResult inferTypeOfLiteral fcx lit = @@ -714,6 +748,7 @@ Typing.inferenceResultSubst = Substitution.idTypeSubst, Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} + -- | Infer the type of a map (Either version) inferTypeOfMap :: Typing.InferenceContext -> Graph.Graph -> M.Map Core.Term Core.Term -> Either Errors.Error Typing.InferenceResult inferTypeOfMap fcx cx m = @@ -765,12 +800,14 @@ subst]) (Substitution.substInClassConstraints subst allMapConstraints)) (Lists.concat [ kcons, vcons])) (\mcResult -> Right mcResult))))))) + -- | Infer the type of a Maybe value 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) 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) inferTypeOfPair :: Typing.InferenceContext -> Graph.Graph -> (Core.Term, Core.Term) -> Either Errors.Error Typing.InferenceResult inferTypeOfPair fcx cx p = @@ -794,6 +831,7 @@ in (Right (yieldWithConstraints fcx2 termWithTypes (Core.TypePair (Core.PairType { 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 = @@ -804,6 +842,7 @@ 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) inferTypeOfProjection :: Typing.InferenceContext -> Graph.Graph -> Core.Projection -> Either Errors.Error Typing.InferenceResult inferTypeOfProjection fcx cx proj = @@ -820,6 +859,7 @@ Core.projectionFieldName = fname}))) (Core.TypeFunction (Core.FunctionType { 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) inferTypeOfRecord :: Typing.InferenceContext -> Graph.Graph -> Core.Record -> Either Errors.Error Typing.InferenceResult inferTypeOfRecord fcx cx record = @@ -852,10 +892,12 @@ Typing.typeConstraintLeft = stype, Typing.typeConstraintRight = ityp, Typing.typeConstraintComment = "schema type of record"}]) (\mcResult -> Right mcResult)))))) + -- | Infer the type of a set (Either version) 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) + -- | Infer the type of a given term (Either version) inferTypeOfTerm :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> String -> Either Errors.Error Typing.InferenceResult inferTypeOfTerm fcx cx term desc = @@ -883,6 +925,7 @@ Core.TermUnwrap v0 -> inferTypeOfUnwrap fcx2 cx v0 Core.TermVariable v0 -> inferTypeOfVariable fcx2 cx v0 Core.TermWrap v0 -> inferTypeOfWrappedTerm fcx2 cx v0 + -- | Infer the type of a type application (Either version) inferTypeOfTypeApplication :: Typing.InferenceContext -> Graph.Graph -> Core.TypeApplicationTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfTypeApplication fcx cx tt = @@ -896,6 +939,7 @@ Typing.inferenceResultSubst = (Typing.inferenceResultSubst result), Typing.inferenceResultClassConstraints = (Typing.inferenceResultClassConstraints result), Typing.inferenceResultContext = fcx2})))) + -- | Infer the type of a type abstraction (Either version) inferTypeOfTypeLambda :: Typing.InferenceContext -> Graph.Graph -> Core.TypeLambda -> Either Errors.Error Typing.InferenceResult inferTypeOfTypeLambda fcx cx ta = @@ -909,6 +953,7 @@ Typing.inferenceResultSubst = (Typing.inferenceResultSubst result), Typing.inferenceResultClassConstraints = (Typing.inferenceResultClassConstraints result), Typing.inferenceResultContext = fcx2})))) + -- | The trivial inference rule for the unit term inferTypeOfUnit :: Typing.InferenceContext -> Typing.InferenceResult inferTypeOfUnit fcx = @@ -918,6 +963,7 @@ Typing.inferenceResultSubst = Substitution.idTypeSubst, Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} + -- | Infer the type of an unwrap operation (Either version) inferTypeOfUnwrap :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> Either Errors.Error Typing.InferenceResult inferTypeOfUnwrap fcx cx tname = @@ -929,6 +975,7 @@ in (Eithers.bind (ExtractCore.wrappedType tname stype) (\wtyp -> Right (yield fcx2 (buildTypeApplicationTerm svars (Core.TermUnwrap tname)) (Core.TypeFunction (Core.FunctionType { 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) inferTypeOfVariable :: Typing.InferenceContext -> Graph.Graph -> Core.Name -> Either Errors.Error Typing.InferenceResult inferTypeOfVariable fcx cx name = @@ -949,6 +996,7 @@ Typing.inferenceResultSubst = Substitution.idTypeSubst, Typing.inferenceResultClassConstraints = constraints, Typing.inferenceResultContext = fcx2}))) + -- | Infer the type of a wrapped term (Either version) inferTypeOfWrappedTerm :: Typing.InferenceContext -> Graph.Graph -> Core.WrappedTerm -> Either Errors.Error Typing.InferenceResult inferTypeOfWrappedTerm fcx cx wt = @@ -974,6 +1022,7 @@ Typing.typeConstraintLeft = stype, Typing.typeConstraintRight = ityp, Typing.typeConstraintComment = "schema type of wrapper"}]) (\mcResult -> Right mcResult)))))) + -- | Infer types for temporary let bindings (Either version) inferTypesOfTemporaryBindings :: Typing.InferenceContext -> Graph.Graph -> [Core.Binding] -> Either Errors.Error ( ([Core.Term], ([Core.Type], (Typing.TypeSubst, (M.Map Core.Name Core.TypeVariableConstraints)))), @@ -1019,16 +1068,19 @@ Lists.cons (Substitution.substTypesInTerm r j) h, (Lists.cons (Substitution.substInType r u_prime) r_prime, (Substitution.composeTypeSubst u r, mergedConstraints))), fcx3)))))))))) + -- | Check if a variable is unbound in context isUnbound :: Graph.Graph -> Core.Name -> Bool isUnbound cx v = Logic.and (Logic.not (Sets.member v (freeVariablesInContext cx))) (Logic.not (Maps.member v (Graph.graphSchemaTypes cx))) + -- | Map over type constraints after unification mapConstraints :: Typing.InferenceContext -> Graph.Graph -> (Typing.TypeSubst -> t0) -> [Typing.TypeConstraint] -> Either Errors.Error t0 mapConstraints flowCx cx f constraints = Eithers.bind (Eithers.bimap (\_e -> Errors.ErrorInference (Errors.InferenceErrorUnification (Errors.UnificationInferenceError { Errors.unificationInferenceErrorPath = (Paths.SubtermPath (Lists.reverse (Typing.inferenceContextTrace flowCx))), Errors.unificationInferenceErrorCause = _e}))) (\_a -> _a) (Unification.unifyTypeConstraints flowCx (Graph.graphSchemaTypes cx) constraints)) (\s -> Eithers.bind (Checking.checkTypeSubst flowCx cx s) (\_ -> Right (f s))) + -- | Merge two maps of class constraints. When both maps have constraints for the same variable, union the class sets. mergeClassConstraints :: Ord t0 => (M.Map t0 Core.TypeVariableConstraints -> M.Map t0 Core.TypeVariableConstraints -> M.Map t0 Core.TypeVariableConstraints) mergeClassConstraints m1 m2 = @@ -1040,6 +1092,7 @@ Core.TypeVariableConstraints { Core.typeVariableConstraintsClasses = (Lists.nub (Lists.concat2 (Core.typeVariableConstraintsClasses existing) (Core.typeVariableConstraintsClasses v)))} in (Maps.insert k merged acc)))) m1 (Maps.toList m2) + -- | Show an inference result for debugging showInferenceResult :: Typing.InferenceResult -> String showInferenceResult result = @@ -1055,6 +1108,7 @@ ", subst=", (ShowTyping.typeSubst subst), "}"]) + -- | Create an inference result with no class constraints yield :: Typing.InferenceContext -> Core.Term -> Core.Type -> Typing.TypeSubst -> Typing.InferenceResult yield fcx term typ subst = @@ -1064,6 +1118,7 @@ Typing.inferenceResultSubst = subst, Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} + -- | Create a checked inference result yieldChecked :: Typing.InferenceContext -> Core.Term -> Core.Type -> Typing.TypeSubst -> Typing.InferenceResult yieldChecked fcx term typ subst = @@ -1076,6 +1131,7 @@ Typing.inferenceResultSubst = subst, Typing.inferenceResultClassConstraints = Maps.empty, Typing.inferenceResultContext = fcx} + -- | Create a checked inference result with class constraints yieldCheckedWithConstraints :: Typing.InferenceContext -> Core.Term -> Core.Type -> Typing.TypeSubst -> M.Map Core.Name Core.TypeVariableConstraints -> Typing.InferenceResult yieldCheckedWithConstraints fcx term typ subst constraints = @@ -1089,6 +1145,7 @@ Typing.inferenceResultSubst = subst, Typing.inferenceResultClassConstraints = iconstraints, Typing.inferenceResultContext = fcx} + -- | Create an inference result with class constraints yieldWithConstraints :: Typing.InferenceContext -> Core.Term -> Core.Type -> Typing.TypeSubst -> M.Map Core.Name Core.TypeVariableConstraints -> Typing.InferenceResult yieldWithConstraints fcx term typ subst constraints = diff --git a/src/main/haskell/Hydra/Json/Bootstrap.hs b/src/main/haskell/Hydra/Json/Bootstrap.hs --- a/src/main/haskell/Hydra/Json/Bootstrap.hs +++ b/src/main/haskell/Hydra/Json/Bootstrap.hs @@ -1,7 +1,9 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A module which provides a minimal typing environment for decoding other modules from JSON. This avoids certain problems with generating entire source modules into target languages like Java, which is subject to method size limits for large modules like hydra.core. module Hydra.Json.Bootstrap where + import qualified Hydra.Coders as Coders import qualified Hydra.Core as Core import qualified Hydra.Error.Checking as Checking @@ -16,6 +18,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | A bootstrap typing environment for decoding modules from JSON. Maps each kernel type name to its encoded type, used to seed JSON decoding before the full kernel graph is available. typesByName :: M.Map Core.Name Core.Type typesByName = @@ -31,39 +34,43 @@ Core.forallTypeParameter = (Core.Name "v1"), Core.forallTypeBody = (Core.TypeForall (Core.ForallType { Core.forallTypeParameter = (Core.Name "v2"), - Core.forallTypeBody = (Core.TypeRecord [ - Core.FieldType { - Core.fieldTypeName = (Core.Name "isLossy"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeLiteral Core.LiteralTypeBoolean), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Whether information may be lost in the course of this adaptation")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "source"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "t1")), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "The source type")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "target"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "t2")), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "The target type")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "coder"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Coder")), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))})), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "The coder for transforming instances of the source type to instances of the target type")))]))}))}])}))}))}))})), + Core.forallTypeBody = (Core.TypeForall (Core.ForallType { + Core.forallTypeParameter = (Core.Name "e"), + Core.forallTypeBody = (Core.TypeRecord [ + Core.FieldType { + Core.fieldTypeName = (Core.Name "isLossy"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeLiteral Core.LiteralTypeBoolean), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "Whether information may be lost in the course of this adaptation")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "source"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "t1")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "The source type")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "target"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "t2")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "The target type")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "coder"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Coder")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "e"))})), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "The coder for transforming instances of the source type to instances of the target type")))]))}))}])}))}))}))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -95,11 +102,13 @@ Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Type"))})), Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Type"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Type"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.errors.Error"))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -119,43 +128,49 @@ Core.forallTypeParameter = (Core.Name "v1"), Core.forallTypeBody = (Core.TypeForall (Core.ForallType { Core.forallTypeParameter = (Core.Name "v2"), - Core.forallTypeBody = (Core.TypeRecord [ - Core.FieldType { - Core.fieldTypeName = (Core.Name "encode"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { - Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")), - Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.forallTypeBody = (Core.TypeForall (Core.ForallType { + Core.forallTypeParameter = (Core.Name "e"), + Core.forallTypeBody = (Core.TypeRecord [ + Core.FieldType { + Core.fieldTypeName = (Core.Name "encode"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")), + Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t1"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t2"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))}))})), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A function from source types to adapters")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "decode"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { - Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")), - Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t1"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t2"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "e"))}))})), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A function from source types to adapters")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "decode"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")), + Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t2"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t1"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))}))})), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A function from target types to adapters")))]))}))}])}))}))}))})), + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t2"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t1"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v2"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v1"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "e"))}))})), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A function from target types to adapters")))]))}))}])}))}))}))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -251,39 +266,37 @@ Core.forallTypeParameter = (Core.Name "v1"), Core.forallTypeBody = (Core.TypeForall (Core.ForallType { Core.forallTypeParameter = (Core.Name "v2"), - Core.forallTypeBody = (Core.TypeRecord [ - Core.FieldType { - Core.fieldTypeName = (Core.Name "encode"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { - Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.typing.InferenceContext")), - Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.forallTypeBody = (Core.TypeForall (Core.ForallType { + Core.forallTypeParameter = (Core.Name "e"), + Core.forallTypeBody = (Core.TypeRecord [ + Core.FieldType { + Core.fieldTypeName = (Core.Name "encode"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v1")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { - Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.Error")), - Core.eitherTypeRight = (Core.TypeVariable (Core.Name "v2"))}))}))})), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A function which encodes source values as target values, given an InferenceContext for fresh-variable state and subterm-path tracing")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "decode"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { - Core.functionTypeDomain = (Core.TypeVariable (Core.Name "hydra.typing.InferenceContext")), - Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType { + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "e")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "v2"))}))})), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A function which encodes a domain value to a codomain value, with the possibility of failure")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "decode"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeFunction (Core.FunctionType { Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v2")), Core.functionTypeCodomain = (Core.TypeEither (Core.EitherType { - Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "hydra.errors.Error")), - Core.eitherTypeRight = (Core.TypeVariable (Core.Name "v1"))}))}))})), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A function which decodes target values as source values, given an InferenceContext for fresh-variable state and subterm-path tracing")))]))}))}])}))})), + Core.eitherTypeLeft = (Core.TypeVariable (Core.Name "e")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "v1"))}))})), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A function which decodes a codomain value to a domain value, with the possibility of failure")))]))}))}])}))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "An encoder and decoder; a bidirectional transformation between two types")))]))}))), + (Core.TermLiteral (Core.LiteralString "An encoder and decoder; a pair of partial functions between two types")))]))}))), ( Core.Name "hydra.coders.CoderDirection", (Core.TypeAnnotated (Core.AnnotatedType { @@ -335,7 +348,7 @@ Core.FieldType { Core.fieldTypeName = (Core.Name "defaultFileExtension"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.util.FileExtension")), + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.file.FileExtension")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -437,15 +450,19 @@ Core.forallTypeParameter = (Core.Name "t"), Core.forallTypeBody = (Core.TypeForall (Core.ForallType { Core.forallTypeParameter = (Core.Name "v"), - Core.forallTypeBody = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.forallTypeBody = (Core.TypeForall (Core.ForallType { + Core.forallTypeParameter = (Core.Name "e"), + Core.forallTypeBody = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v"))}))}))})), + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.Adapter")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "v"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "e"))}))}))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -481,9 +498,11 @@ Core.eitherTypeLeft = (Core.TypeLiteral Core.LiteralTypeString), Core.eitherTypeRight = (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { - Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.SymmetricAdapter")), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Type"))})), - Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Term"))}))}))}))})), + Core.applicationTypeFunction = (Core.TypeApplication (Core.ApplicationType { + Core.applicationTypeFunction = (Core.TypeVariable (Core.Name "hydra.coders.SymmetricAdapter")), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Type"))})), + Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "hydra.core.Term"))})), + Core.applicationTypeArgument = (Core.TypeLiteral Core.LiteralTypeString)}))}))}))})), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -1339,6 +1358,14 @@ Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A type application")))]))}))}, Core.FieldType { + Core.fieldTypeName = (Core.Name "effect"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.core.Type")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "An effectful computation which, when interpreted by a host application, may perform host interactions and produce a value of the given type")))]))}))}, + Core.FieldType { Core.fieldTypeName = (Core.Name "either"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.core.EitherType")), @@ -2207,6 +2234,12 @@ (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeUnion [ Core.FieldType { + Core.fieldTypeName = (Core.Name "primitive"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.PrimitiveDefinition")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A primitive definition")))]))}))}, + Core.FieldType { Core.fieldTypeName = (Core.Name "term"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.TermDefinition")), @@ -2217,13 +2250,7 @@ Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.TypeDefinition")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A type definition")))]))}))}, - Core.FieldType { - Core.fieldTypeName = (Core.Name "primitive"), - Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.PrimitiveDefinition")), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A primitive definition")))]))}))}]), + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A type definition")))]))}))}]), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -2233,13 +2260,13 @@ (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeUnion [ Core.FieldType { - Core.fieldTypeName = (Core.Name "type"), + Core.fieldTypeName = (Core.Name "primitive"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.core.Name")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A reference to a type definition, by name")))]))}))}, + (Core.TermLiteral (Core.LiteralString "A reference to a primitive definition, by name")))]))}))}, Core.FieldType { Core.fieldTypeName = (Core.Name "term"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { @@ -2249,18 +2276,58 @@ Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A reference to a term definition, by name")))]))}))}, Core.FieldType { - Core.fieldTypeName = (Core.Name "primitive"), + Core.fieldTypeName = (Core.Name "type"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.core.Name")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A reference to a primitive definition, by name")))]))}))}]), + (Core.TermLiteral (Core.LiteralString "A reference to a type definition, by name")))]))}))}]), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A typed reference to a definition: a type, a term, or a primitive, identified by name")))]))}))), ( + Core.Name "hydra.packaging.DependencyScope", + (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeUnion [ + Core.FieldType { + Core.fieldTypeName = (Core.Name "api"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = Core.TypeUnit, + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A dependency exported transitively to consumers of this package (e.g. Gradle `api`, Cabal `build-depends`): present at both compile time and runtime, and visible downstream")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "runtime"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = Core.TypeUnit, + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A dependency required at runtime but not at compile time")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "test"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = Core.TypeUnit, + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A dependency required only to compile and run the package's tests")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "tool"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = Core.TypeUnit, + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A build-tool-only dependency, used to generate or process sources at build time but not present in the compiled artifact (e.g. an ANTLR tool jar or an annotation processor)")))]))}))}]), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "The scope in which a package dependency is required. Relevant mainly to dependencies on third-party (non-Hydra) artifacts, where build systems distinguish compile-time, runtime, test-only, and build-tool-only dependencies. Hydra inter-package dependencies normally leave the scope unspecified.")))]))}))), + ( Core.Name "hydra.packaging.EntityMetadata", (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeRecord [ @@ -2305,11 +2372,13 @@ (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeUnion [ Core.FieldType { - Core.fieldTypeName = (Core.Name "package"), + Core.fieldTypeName = (Core.Name "definition"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.PackageName")), + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.DefinitionReference")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A reference to a package, by name")))]))}))}, + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A reference to a definition (type, term, or primitive), by name")))]))}))}, Core.FieldType { Core.fieldTypeName = (Core.Name "module"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { @@ -2317,17 +2386,31 @@ Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A reference to a module, by name")))]))}))}, Core.FieldType { - Core.fieldTypeName = (Core.Name "definition"), + Core.fieldTypeName = (Core.Name "package"), Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.DefinitionReference")), + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.PackageName")), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A reference to a package, by name")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "termExpr"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeLiteral Core.LiteralTypeString), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A reference to a definition (type, term, or primitive)")))]))}))}]), + (Core.TermLiteral (Core.LiteralString "An inline term expression in Hydra textual syntax")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "typeExpr"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeLiteral Core.LiteralTypeString), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "An inline type expression in Hydra textual syntax")))]))}))}]), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A typed reference to a packaging entity: a package, a module, or a definition")))]))}))), + (Core.TermLiteral (Core.LiteralString "A typed reference to a Hydra entity: a package, a module, a definition (by name), or an inline type or term expression in Hydra textual syntax.")))]))}))), ( Core.Name "hydra.packaging.LifecycleInfo", (Core.TypeAnnotated (Core.AnnotatedType { @@ -2473,7 +2556,15 @@ Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "The version-range constraint on the depended-on package")))]))}))}]), + (Core.TermLiteral (Core.LiteralString "The version-range constraint on the depended-on package")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "scope"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeOptional (Core.TypeVariable (Core.Name "hydra.packaging.DependencyScope"))), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "The scope in which the dependency is required, if specified. Normally absent for Hydra inter-package dependencies; specified for third-party dependencies whose build scope (compile/runtime/test/tool) is significant.")))]))}))}]), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), @@ -2485,7 +2576,7 @@ Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "The unique name of a package, e.g. \"hydra-kernel\" or \"hydra-python\"")))]))}))), + (Core.TermLiteral (Core.LiteralString "The unique name of a package, e.g. \"hydra-kernel\" or \"hydra-python\". For dependencies on third-party artifacts in ecosystems with a group/namespace component (notably Maven), the group and artifact are carried in a single name separated by a colon, e.g. \"org.eclipse.rdf4j:rdf4j-rio-ntriples\"; the consuming host splits on the colon to recover the group when emitting build configuration. Hydra package names contain no colon.")))]))}))), ( Core.Name "hydra.packaging.PrimitiveDefinition", (Core.TypeAnnotated (Core.AnnotatedType { @@ -2613,6 +2704,30 @@ Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "A version string, e.g. \"0.15\" or \"1.0.0\".")))]))}))), ( + Core.Name "hydra.packaging.VersionRange", + (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeRecord [ + Core.FieldType { + Core.fieldTypeName = (Core.Name "lowerInclusive"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeOptional (Core.TypeVariable (Core.Name "hydra.packaging.Version"))), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "The inclusive lower bound, if any (the minimum acceptable version).")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "upperExclusive"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeOptional (Core.TypeVariable (Core.Name "hydra.packaging.Version"))), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "The exclusive upper bound, if any (versions strictly below this are acceptable).")))]))}))}]), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A version range with an optional inclusive lower bound and an optional exclusive upper bound.")))]))}))), + ( Core.Name "hydra.packaging.VersionSpecifier", (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = (Core.TypeUnion [ @@ -2621,11 +2736,35 @@ Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { Core.annotatedTypeBody = Core.TypeUnit, Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "Any version satisfies the dependency")))]))}))}]), + (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "Any version satisfies the dependency")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "exact"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.Version")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "Exactly the given version satisfies the dependency; used to pin a specific release")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "atLeast"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.Version")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "Any version greater than or equal to the given version (e.g. PyPI \">=7.0\")")))]))}))}, + Core.FieldType { + Core.fieldTypeName = (Core.Name "range"), + Core.fieldTypeType = (Core.TypeAnnotated (Core.AnnotatedType { + Core.annotatedTypeBody = (Core.TypeVariable (Core.Name "hydra.packaging.VersionRange")), + Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ + ( + Core.TermVariable (Core.Name "description"), + (Core.TermLiteral (Core.LiteralString "A version range with an optional inclusive lower bound and optional exclusive upper bound (e.g. \">=3.7,<4.0\")")))]))}))}]), Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ ( Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A specifier constraining acceptable versions of a dependency. Currently only the `any` (unit) specifier is defined; future variants such as `exact`, `caret`, and `range` may be added without breaking consumers of the `any` form.")))]))}))), + (Core.TermLiteral (Core.LiteralString "A specifier constraining acceptable versions of a dependency. Build systems render each variant into their own syntax (e.g. a range becomes \">=3.7,<4.0\" for PyPI or \"[3.7,4.0)\" for Maven). Further variants such as `caret` may be added without breaking consumers of the existing forms.")))]))}))), ( Core.Name "hydra.typing.FunctionStructure", (Core.TypeAnnotated (Core.AnnotatedType { @@ -2967,14 +3106,6 @@ ( Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "An equality judgement: less than, equal to, or greater than")))]))}))), - ( - Core.Name "hydra.util.FileExtension", - (Core.TypeAnnotated (Core.AnnotatedType { - Core.annotatedTypeBody = (Core.TypeWrap (Core.TypeLiteral Core.LiteralTypeString)), - Core.annotatedTypeAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "A file extension (without the dot), e.g. \"json\" or \"py\"")))]))}))), ( Core.Name "hydra.util.ModuleNames", (Core.TypeAnnotated (Core.AnnotatedType { 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 @@ -1,26 +1,32 @@ -- Note: this is an automatically generated file. Do not edit. + -- | JSON decoding for Hydra terms. Converts JSON Values to Terms using Either for error handling. module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as LibLiterals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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 LibLiterals +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.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Literals as Literals import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing @@ -29,8 +35,10 @@ import qualified Hydra.Relational as Relational import qualified Hydra.Show.Core as ShowCore 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 @@ -40,6 +48,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Decode a JSON value to a float term. Finite values arrive as JSON numbers; NaN/Inf/-0.0 arrive as JSON string sentinels. Float32 and Float64 are symmetric. decodeFloat :: Core.FloatType -> Model.Value -> Either String Core.Term decodeFloat ft value = @@ -56,6 +65,7 @@ "invalid float64 sentinel: ", v1])) (\v -> Right (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v)))) _ -> Left "expected number or special float string for float64" + -- | Decode a JSON value to an integer term. Small ints from numbers; large ints from strings. decodeInteger :: Core.IntegerType -> Model.Value -> Either String Core.Term decodeInteger it value = @@ -104,6 +114,7 @@ "invalid uint32: ", v1])) (\v -> Right (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 v))))) _ -> Left "expected number or string for uint32" + -- | Decode a JSON value to a literal term decodeLiteral :: Core.LiteralType -> Model.Value -> Either String Core.Term decodeLiteral lt value = @@ -122,30 +133,35 @@ Core.LiteralTypeString -> let strResult = expectString value in (Eithers.map (\s -> Core.TermLiteral (Core.LiteralString s)) strResult) + -- | Extract an array from a JSON value expectArray :: Model.Value -> Either String [Model.Value] expectArray value = case value of Model.ValueArray v0 -> Right v0 _ -> Left "expected array" + -- | Extract a number from a JSON value expectNumber :: Model.Value -> Either String Sci.Scientific expectNumber value = case value of Model.ValueNumber v0 -> Right v0 _ -> Left "expected number" + -- | Extract an object from a JSON value as a name-keyed map. Field order is not preserved here; decoding looks fields up 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 "expected object" + -- | Extract a string from a JSON value expectString :: Model.Value -> Either String String expectString value = case value of Model.ValueString v0 -> Right v0 _ -> Left "expected string" + -- | Decode a JSON value to a Hydra term given a type and type name. Returns Left for type mismatches. fromJson :: M.Map Core.Name Core.Type -> Core.Name -> Core.Type -> Model.Value -> Either String Core.Term fromJson types tname typ value = @@ -220,8 +236,26 @@ \obj -> Optionals.cases (Lists.maybeHead (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") - objResult = expectObject value - in (Eithers.either (\err -> Left err) (\obj -> processUnion obj) objResult) + decodeCompactString = + \s -> Optionals.cases (Lists.find (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) s) v0) (Left (Strings.cat [ + "unknown variant: ", + s])) (\ft -> + let ftypeStripped = Strip.deannotateType (Core.fieldTypeType ft) + in case ftypeStripped of + Core.TypeUnit -> Right (Core.TermInject (Core.Injection { + Core.injectionTypeName = tname, + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name s), + Core.fieldTerm = Core.TermUnit}})) + _ -> Left (Strings.cat [ + "compact string form requires unit-typed variant, got non-unit type for variant: ", + s])) + in case value of + Model.ValueString v1 -> decodeCompactString v1 + Model.ValueObject v1 -> + let objAsMap = Maps.fromList v1 + in (processUnion objAsMap) + _ -> Left "expected string or object for union" Core.TypeUnit -> let objResult = expectObject value in (Eithers.map (\_2 -> Core.TermUnit) objResult) @@ -278,10 +312,12 @@ _ -> Left (Strings.cat [ "unsupported type for JSON decoding: ", (ShowCore.type_ typ)]) + -- | Parse an IEEE sentinel string (NaN, Infinity, -Infinity, -0.0) to a float64. Returns Nothing for unrecognized strings. parseSpecialFloat :: String -> Maybe Double parseSpecialFloat s = Logic.ifElse (Logic.or (Equality.equal s "NaN") (Logic.or (Equality.equal s "Infinity") (Logic.or (Equality.equal s "-Infinity") (Equality.equal s "-0.0")))) (LibLiterals.readFloat64 s) Nothing + -- | Parse an IEEE sentinel string (NaN, Infinity, -Infinity, -0.0) to a float32. Returns Nothing for unrecognized strings. parseSpecialFloat32 :: String -> Maybe Float parseSpecialFloat32 s = 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 @@ -1,27 +1,35 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Decoding functions for JSON data module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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 @@ -31,32 +39,38 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Decode a JSON array using a decoder for elements decodeArray :: (Model.Value -> Either String t0) -> Model.Value -> Either String [t0] decodeArray decodeElem x = case x of Model.ValueArray v0 -> Eithers.mapList decodeElem v0 _ -> Left "expected an array" + -- | Decode a JSON boolean value decodeBoolean :: Model.Value -> Either String Bool decodeBoolean x = case x of Model.ValueBoolean v0 -> Right v0 _ -> Left "expected a boolean" + -- | 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)) + -- | 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) decodeObject x = case x of Model.ValueObject v0 -> Right (Maps.fromList v0) _ -> Left "expected an object" + -- | Decode an optional field from a JSON object decodeOptionalField :: Ord t3 => ((t0 -> Either t1 t2) -> t3 -> M.Map t3 t0 -> Either t1 (Maybe t2)) decodeOptionalField decodeValue name m = Optionals.cases (Maps.lookup name m) (Right Nothing) (\v -> Eithers.map (\x -> Just x) (decodeValue v)) + -- | Decode a JSON string value decodeString :: Model.Value -> Either String String decodeString x = 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 @@ -1,27 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | JSON encoding for Hydra terms. Converts Terms to JSON Values using Either for error handling. module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as LibLiterals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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 LibLiterals +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.Literals as Literals import qualified Hydra.Packaging as Packaging import qualified Hydra.Parsing as Parsing @@ -30,8 +36,10 @@ import qualified Hydra.Relational as Relational import qualified Hydra.Show.Core as ShowCore 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 @@ -41,6 +49,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Encode a float value to JSON. Finite values become JSON numbers (shortest round-trip); IEEE specials (NaN/Inf/-0.0) become JSON strings. Float32 and Float64 are symmetric; the schema disambiguates precision on decode. encodeFloat :: Core.FloatValue -> Either t0 Model.Value encodeFloat fv = @@ -51,6 +60,7 @@ Core.FloatValueFloat64 v0 -> let s = LibLiterals.showFloat64 v0 in (Logic.ifElse (requiresJsonStringSentinel s) (Right (Model.ValueString s)) (Right (Model.ValueNumber (LibLiterals.float64ToDecimal v0)))) + -- | Encode an integer value to JSON. Small ints use native numbers; large ints use strings. encodeInteger :: Core.IntegerValue -> Either t0 Model.Value encodeInteger iv = @@ -64,6 +74,7 @@ Core.IntegerValueUint8 v0 -> Right (Model.ValueNumber (LibLiterals.bigintToDecimal (LibLiterals.uint8ToBigint v0))) Core.IntegerValueUint16 v0 -> Right (Model.ValueNumber (LibLiterals.bigintToDecimal (LibLiterals.uint16ToBigint v0))) Core.IntegerValueUint32 v0 -> Right (Model.ValueNumber (LibLiterals.bigintToDecimal (LibLiterals.uint32ToBigint v0))) + -- | Encode a Hydra literal to a JSON value encodeLiteral :: Core.Literal -> Either t0 Model.Value encodeLiteral lit = @@ -74,10 +85,12 @@ Core.LiteralFloat v0 -> encodeFloat v0 Core.LiteralInteger v0 -> encodeInteger v0 Core.LiteralString v0 -> Right (Model.ValueString v0) + -- | True for IEEE sentinel strings that JSON must escape as a string to preserve. requiresJsonStringSentinel :: String -> Bool requiresJsonStringSentinel s = Logic.or (Equality.equal s "NaN") (Logic.or (Equality.equal s "Infinity") (Logic.or (Equality.equal s "-Infinity") (Equality.equal s "-0.0"))) + -- | Encode a Hydra term to a JSON value given a type and type name. Returns Left for unsupported constructs. toJson :: M.Map Core.Name Core.Type -> Core.Name -> Core.Type -> Core.Term -> Either String Model.Value toJson types tname typ term = @@ -151,9 +164,15 @@ "unknown variant: ", fname])) (\ft -> Right (Core.fieldTypeType ft)) in (Eithers.either (\err -> Left err) (\ftype -> - let encodedUnion = toJson types tname ftype fterm - in (Eithers.map (\v -> Model.ValueObject [ - (fname, v)]) encodedUnion)) ftypeResult) + let ftypeStripped = Strip.deannotateType ftype + isUnit = + case ftypeStripped of + Core.TypeUnit -> True + _ -> False + in (Logic.ifElse isUnit (Right (Model.ValueString fname)) ( + let encodedUnion = toJson types tname ftype fterm + in (Eithers.map (\v -> Model.ValueObject [ + (fname, v)]) encodedUnion)))) ftypeResult) _ -> Left "expected union term" Core.TypeUnit -> Right (Model.ValueObject []) Core.TypeWrap v0 -> case strippedTerm of @@ -207,6 +226,7 @@ _ -> Left (Strings.cat [ "unsupported type for JSON encoding: ", (ShowCore.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 toJsonUntyped term = @@ -239,9 +259,15 @@ let field = Core.injectionField v0 fname = Core.unName (Core.fieldName field) fterm = Core.fieldTerm field - encodedUnion = toJsonUntyped fterm - in (Eithers.map (\v -> Model.ValueObject [ - (fname, v)]) encodedUnion) + ftermStripped = Strip.deannotateTerm fterm + isUnit = + case ftermStripped of + Core.TermUnit -> True + _ -> False + in (Logic.ifElse isUnit (Right (Model.ValueString fname)) ( + let encodedUnion = toJsonUntyped fterm + in (Eithers.map (\v -> Model.ValueObject [ + (fname, v)]) encodedUnion))) Core.TermUnit -> Right (Model.ValueObject []) Core.TermWrap v0 -> toJsonUntyped (Core.wrappedTermBody v0) Core.TermMap v0 -> diff --git a/src/main/haskell/Hydra/Json/Model.hs b/src/main/haskell/Hydra/Json/Model.hs --- a/src/main/haskell/Hydra/Json/Model.hs +++ b/src/main/haskell/Hydra/Json/Model.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A JSON syntax model. See the BNF at https://www.json.org module Hydra.Json.Model 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 JSON value data Value = -- | A JSON array @@ -20,10 +23,17 @@ -- | A string value ValueString String deriving (Eq, Ord, Read, Show) + _Value = Core.Name "hydra.json.model.Value" + _Value_array = Core.Name "array" + _Value_boolean = Core.Name "boolean" + _Value_null = Core.Name "null" + _Value_number = Core.Name "number" + _Value_object = Core.Name "object" + _Value_string = Core.Name "string" 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 @@ -1,30 +1,38 @@ -- Note: this is an automatically generated file. Do not edit. + -- | JSON parser using Hydra parser combinators module Hydra.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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Optionals as Optionals +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.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 @@ -33,21 +41,26 @@ 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 Hydra.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals + -- | Parse a single digit (0-9) digit :: Parsing.Parser Int digit = Parsers.satisfy (\c -> Logic.and (Equality.gte c 48) (Equality.lte c 57)) + -- | Parse one or more digits as a string digits :: Parsing.Parser String digits = Parsers.map Strings.fromList (Parsers.some digit) + -- | Parse a JSON array jsonArray :: Parsing.Parser Model.Value jsonArray = Parsers.map (\x -> Model.ValueArray x) (Parsers.between (token (Parsers.char 91)) (token (Parsers.char 93)) (Parsers.sepBy (Parsers.lazy (\_ -> jsonValue)) (token (Parsers.char 44)))) + -- | Parse JSON boolean (true or false) jsonBool :: Parsing.Parser Model.Value jsonBool = Parsers.alt (Parsers.map (\_ -> Model.ValueBoolean True) (token (Parsers.string "true"))) (Parsers.map (\_ -> Model.ValueBoolean False) (token (Parsers.string "false"))) + -- | Parse a JSON escape sequence after the backslash jsonEscapeChar :: Parsing.Parser Int jsonEscapeChar = @@ -60,24 +73,30 @@ (Parsers.map (\_ -> 10) (Parsers.char 110)), (Parsers.map (\_ -> 13) (Parsers.char 114)), (Parsers.map (\_ -> 9) (Parsers.char 116))] + -- | 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))) + -- | 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)) + -- | 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)))) + -- | Parse a JSON object key-value pair jsonKeyValue :: Parsing.Parser (String, Model.Value) jsonKeyValue = Parsers.bind (token (Parsers.bind (Parsers.char 34) (\_ -> Parsers.bind (Parsers.many jsonStringChar) (\chars -> Parsers.bind (Parsers.char 34) (\_2 -> Parsers.pure (Strings.fromList chars)))))) (\key -> Parsers.bind (token (Parsers.char 58)) (\_ -> Parsers.map (\v -> (key, v)) (Parsers.lazy (\_2 -> jsonValue)))) + -- | Parse JSON null value jsonNull :: Parsing.Parser Model.Value jsonNull = Parsers.map (\_ -> Model.ValueNull) (token (Parsers.string "null")) + -- | Parse a JSON number (integer, decimal, or scientific notation) jsonNumber :: Parsing.Parser Model.Value jsonNumber = @@ -85,18 +104,22 @@ 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))))))) + -- | Parse a JSON object jsonObject :: Parsing.Parser Model.Value jsonObject = Parsers.map (\x -> Model.ValueObject x) (Parsers.between (token (Parsers.char 123)) (token (Parsers.char 125)) (Parsers.sepBy jsonKeyValue (token (Parsers.char 44)))) + -- | Parse a JSON string value jsonString :: Parsing.Parser Model.Value jsonString = token (Parsers.bind (Parsers.char 34) (\_ -> Parsers.bind (Parsers.many jsonStringChar) (\chars -> Parsers.bind (Parsers.char 34) (\_2 -> Parsers.pure (Model.ValueString (Strings.fromList chars)))))) + -- | Parse a single character in a JSON string (handling escapes) jsonStringChar :: Parsing.Parser Int jsonStringChar = Parsers.alt (Parsers.bind (Parsers.char 92) (\_ -> jsonEscapeChar)) (Parsers.satisfy (\c -> Logic.and (Logic.not (Equality.equal c 34)) (Logic.not (Equality.equal c 92)))) + -- | Parse any JSON value jsonValue :: Parsing.Parser Model.Value jsonValue = @@ -107,13 +130,16 @@ jsonString, jsonArray, jsonObject] + -- | Parse a JSON document from a string parseJson :: String -> Parsing.ParseResult Model.Value parseJson input = Parsing.unParser (Parsers.bind whitespace (\_ -> Parsers.bind jsonValue (\v -> Parsers.bind whitespace (\_2 -> Parsers.bind Parsers.eof (\_3 -> Parsers.pure v))))) input + -- | Parse a token followed by optional whitespace token :: Parsing.Parser t0 -> Parsing.Parser t0 token p = Parsers.bind p (\x -> Parsers.bind whitespace (\_ -> Parsers.pure x)) + -- | Parse zero or more JSON whitespace characters (space, tab, newline, carriage return) whitespace :: Parsing.Parser () whitespace = 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 @@ -1,32 +1,40 @@ -- Note: this is an automatically generated file. Do not edit. + -- | JSON serialization functions using the Hydra AST module Hydra.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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Math as Math +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.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.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 @@ -35,6 +43,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | The colon operator used to separate keys and values in JSON objects colonOp :: Ast.Op colonOp = @@ -45,6 +54,7 @@ Ast.paddingRight = Ast.WsSpace}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} + -- | Encode a byte (0..255) as a two-character lowercase hex string. Non-byte inputs yield placeholder '?' characters. hexByte :: Int -> String hexByte c = @@ -54,6 +64,7 @@ hi = nibble (Optionals.fromOptional 0 (Math.maybeDiv c 16)) lo = nibble (Optionals.fromOptional 0 (Math.maybeMod c 16)) in (Strings.cat2 hi lo) + -- | Escape and quote a string for JSON output jsonString :: String -> String jsonString s = @@ -63,6 +74,7 @@ \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) "\"") + -- | Convert a key-value pair to an AST expression keyValueToExpr :: (String, Model.Value) -> Ast.Expr keyValueToExpr pair = @@ -70,9 +82,11 @@ let key = Pairs.first pair value = Pairs.second pair in (Serialization.ifx colonOp (Serialization.cst (jsonString key)) (valueToExpr value)) + -- | Serialize a JSON value to a string printJson :: Model.Value -> String printJson value = Serialization.printExpr (valueToExpr value) + -- | Convert a JSON value to an AST expression for serialization valueToExpr :: Model.Value -> Ast.Expr valueToExpr value = 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 @@ -1,28 +1,36 @@ -- Note: this is an automatically generated file. Do not edit. + -- | YAML-to-JSON decoding. Converts YAML Nodes to JSON Values (may fail for non-JSON YAML), and YAML Nodes to Hydra Terms via JSON. module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps +import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs 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 @@ -33,12 +41,14 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Decode a YAML node to a Hydra term via JSON decoding. fromYaml :: M.Map Core.Name Core.Type -> Core.Name -> Core.Type -> YamlModel.Node -> Either String Core.Term fromYaml types tname typ node = let jsonResult = yamlToJson node in (Eithers.either (\err -> Left err) (\json -> Decode.fromJson types tname typ json) jsonResult) + -- | Convert a YAML node to a JSON value. Fails for non-JSON YAML features (e.g. non-string mapping keys). yamlToJson :: YamlModel.Node -> Either String JsonModel.Value yamlToJson node = 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 @@ -1,28 +1,36 @@ -- Note: this is an automatically generated file. Do not edit. + -- | JSON-to-YAML encoding. Converts JSON Values to YAML Nodes (always succeeds), and Hydra Terms to YAML Nodes via JSON. module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -33,6 +41,7 @@ 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 JSON value to a YAML node. Always succeeds since YAML is a superset of JSON. jsonToYaml :: JsonModel.Value -> YamlModel.Node jsonToYaml value = @@ -43,6 +52,7 @@ JsonModel.ValueNumber v0 -> YamlModel.NodeScalar (YamlModel.ScalarDecimal v0) JsonModel.ValueObject v0 -> YamlModel.NodeMapping (Maps.fromList (Lists.map (\kv -> (YamlModel.NodeScalar (YamlModel.ScalarStr (Pairs.first kv)), (jsonToYaml (Pairs.second kv)))) v0)) JsonModel.ValueString v0 -> YamlModel.NodeScalar (YamlModel.ScalarStr v0) + -- | Encode a Hydra term to a YAML node via JSON encoding. toYaml :: M.Map Core.Name Core.Type -> Core.Name -> Core.Type -> Core.Term -> Either String YamlModel.Node toYaml types tname typ term = Eithers.map (\v -> jsonToYaml v) (Encode.toJson types tname typ term) 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 @@ -1,25 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Language constraints for Hydra Core module Hydra.Languages 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.Haskell.Lib.Sets as Sets +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.Reflect as Reflect 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 @@ -28,6 +36,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Language constraints for Hydra Core, i.e. no constraints. hydraLanguage :: Coders.Language hydraLanguage = @@ -55,7 +64,7 @@ Coders.caseConventionsTermVariable = Util.CaseConventionCamel, Coders.caseConventionsType = Util.CaseConventionPascal, Coders.caseConventionsTypeVariable = Util.CaseConventionCamel}, - Coders.languageDefaultFileExtension = (Util.FileExtension "")} + Coders.languageDefaultFileExtension = (File.FileExtension "")} where literalVariants = Sets.fromList Reflect.literalVariants floatTypes = Sets.fromList Reflect.floatTypes 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 @@ -1,27 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A module for lexical operations over graphs. module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -31,8 +37,10 @@ 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 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 @@ -43,6 +51,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Build a Graph from element bindings, environment, and primitives buildGraph :: [Core.Binding] -> M.Map Core.Name (Maybe Core.Term) -> M.Map Core.Name Graph.Primitive -> Graph.Graph buildGraph elements environment primitives = @@ -64,6 +73,7 @@ Graph.graphPrimitives = primitives, Graph.graphSchemaTypes = Maps.empty, Graph.graphTypeVariables = Sets.empty} + -- | Pick a name that does not collide with a reserved set, by appending a numeric suffix to the requested name when necessary chooseUniqueName :: S.Set Core.Name -> Core.Name -> Core.Name chooseUniqueName reserved name = @@ -73,6 +83,7 @@ let candidate = Logic.ifElse (Equality.equal index 1) name (Core.Name (Strings.cat2 (Core.unName name) (Literals.showInt32 index))) in (Logic.ifElse (Sets.member candidate reserved) (tryName (Math.add index 1)) candidate) in (tryName 1) + -- | Resolve a schema type through a chain of zero or more typedefs dereferenceSchemaType :: Core.Name -> M.Map Core.Name Core.TypeScheme -> Maybe Core.TypeScheme dereferenceSchemaType name types = @@ -93,11 +104,13 @@ Core.typeSchemeVariables = (Lists.concat2 (Core.typeSchemeVariables ts) (Core.typeSchemeVariables ts2)), Core.typeSchemeBody = (Core.typeSchemeBody ts2), Core.typeSchemeConstraints = (Core.typeSchemeConstraints ts2)}) (forType (Core.typeSchemeBody ts)))) + -- | Look up a binding by name in a graph, returning Either an error or the binding dereferenceVariable :: Graph.Graph -> Core.Name -> Either Errors.Error Core.Binding dereferenceVariable graph name = Optionals.cases (lookupBinding graph name) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchBinding (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = name})))) (\right_ -> Right right_) + -- | Create a graph from a parent graph, schema types, and list of element bindings elementsToGraph :: Graph.Graph -> M.Map Core.Name Core.TypeScheme -> [Core.Binding] -> Graph.Graph elementsToGraph parent schemaTypes elements = @@ -113,6 +126,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives g), Graph.graphSchemaTypes = schemaTypes, Graph.graphTypeVariables = (Graph.graphTypeVariables g)} + -- | An empty graph; no elements, no primitives, no schema. emptyGraph :: Graph.Graph emptyGraph = @@ -125,12 +139,14 @@ Graph.graphPrimitives = Maps.empty, Graph.graphSchemaTypes = Maps.empty, Graph.graphTypeVariables = Sets.empty} + -- | An empty inference context; fresh-variable counter at zero and empty trace. emptyInferenceContext :: Typing.InferenceContext emptyInferenceContext = Typing.InferenceContext { Typing.inferenceContextFreshTypeVariableCount = 0, Typing.inferenceContextTrace = []} + -- | Extract the fields of a record or union type fieldsOf :: Core.Type -> [Core.FieldType] fieldsOf t = @@ -141,11 +157,13 @@ Core.TypeRecord v0 -> v0 Core.TypeUnion v0 -> v0 _ -> [] + -- | Look up a field by name in a record's field map and decode its value, failing if the field is missing getField :: M.Map Core.Name t0 -> Core.Name -> (t0 -> Either Errors.Error t1) -> Either Errors.Error t1 getField m fname decode = Optionals.cases (Maps.lookup fname m) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoMatchingField (Errors.NoMatchingFieldError { Errors.noMatchingFieldErrorFieldName = fname})))) decode + -- | Reconstruct a list of Bindings from a Graph's boundTerms and boundTypes graphToBindings :: Graph.Graph -> [Core.Binding] graphToBindings g = @@ -156,6 +174,7 @@ Core.bindingName = name, Core.bindingTerm = term, Core.bindingTypeScheme = (Maps.lookup name (Graph.graphBoundTypes g))}) (Maps.toList (Graph.graphBoundTerms g)) + -- | Build a graph with primitives assembled from built-in and user-provided lists. User-provided primitives shadow built-in ones. graphWithPrimitives :: [Graph.Primitive] -> [Graph.Primitive] -> Graph.Graph graphWithPrimitives builtIn userProvided = @@ -163,6 +182,7 @@ let toMap = \ps -> Maps.fromList (Lists.map (\p -> (Packaging.primitiveDefinitionName (Graph.primitiveDefinition p), p)) ps) prims = Maps.union (toMap userProvided) (toMap builtIn) in (buildGraph [] Maps.empty prims) + -- | Look up a binding in a graph by name lookupBinding :: Graph.Graph -> Core.Name -> Maybe Core.Binding lookupBinding graph name = @@ -170,16 +190,20 @@ Core.bindingName = name, Core.bindingTerm = term, Core.bindingTypeScheme = (Maps.lookup name (Graph.graphBoundTypes graph))}) (Maps.lookup name (Graph.graphBoundTerms graph)) + -- | Look up a primitive function in a graph by name lookupPrimitive :: Graph.Graph -> Core.Name -> Maybe Graph.Primitive lookupPrimitive graph name = Maps.lookup name (Graph.graphPrimitives graph) + -- | Look up a term by name in a graph lookupTerm :: Graph.Graph -> Core.Name -> Maybe Core.Term lookupTerm graph name = Maps.lookup name (Graph.graphBoundTerms graph) + -- | Match a term against an enum type, dispatching on the variant name to a value from the supplied list matchEnum :: Graph.Graph -> Core.Name -> [(Core.Name, t0)] -> Core.Term -> Either Errors.Error t0 matchEnum graph tname pairs = matchUnion graph tname (Lists.map (\pair -> matchUnitField (Pairs.first pair) (Pairs.second pair)) pairs) + -- | Match a term against a record type and decode its fields, failing if the term is not a record matchRecord :: t0 -> (M.Map Core.Name Core.Term -> Either Errors.Error t1) -> Core.Term -> Either Errors.Error t1 matchRecord graph decode term = @@ -190,6 +214,7 @@ _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record", Errors.unexpectedShapeErrorActual = (ShowCore.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 matchUnion graph tname pairs term = @@ -211,9 +236,11 @@ _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = (Strings.cat2 "injection for type " (Core.unName tname)), Errors.unexpectedShapeErrorActual = (ShowCore.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)) matchUnitField fname x = (fname, (\ignored -> Right x)) + -- | Look up a binding in a graph by name, failing with a list of available names if it is not found requireBinding :: Graph.Graph -> Core.Name -> Either Errors.Error Core.Binding requireBinding graph name = @@ -225,11 +252,13 @@ 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)))))) "}" 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 requirePrimitive :: Graph.Graph -> Core.Name -> Either Errors.Error Graph.Primitive requirePrimitive graph name = Optionals.cases (lookupPrimitive graph name) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchPrimitive (Errors.NoSuchPrimitiveError { Errors.noSuchPrimitiveErrorName = name})))) (\x -> Right x) + -- | Look up a primitive's type scheme in a graph by name, failing if the primitive is not registered requirePrimitiveType :: Graph.Graph -> Core.Name -> Either Errors.Error Core.TypeScheme requirePrimitiveType tx name = @@ -238,11 +267,13 @@ Optionals.map (\_p -> Scoping.termSignatureToTypeScheme (Packaging.primitiveDefinitionSignature (Graph.primitiveDefinition _p))) (Maps.lookup name (Graph.graphPrimitives tx)) in (Optionals.cases mts (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchPrimitive (Errors.NoSuchPrimitiveError { Errors.noSuchPrimitiveErrorName = name})))) (\ts -> Right ts)) + -- | Resolve a name to a term in the graph, following variable references, and fail if the name is not bound requireTerm :: Graph.Graph -> Core.Name -> Either Errors.Error Core.Term requireTerm graph name = Optionals.cases (resolveTerm graph name) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchBinding (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = name})))) (\x -> Right x) + -- | TODO: distinguish between lambda-bound and let-bound variables resolveTerm :: Graph.Graph -> Core.Name -> Maybe Core.Term resolveTerm graph name = @@ -254,6 +285,7 @@ Core.TermVariable v0 -> resolveTerm graph v0 _ -> Just term in (Optionals.cases (lookupTerm graph name) Nothing recurse) + -- | Strip annotations and type lambdas/applications from a term, then follow variable references through the graph until a non-variable term is reached stripAndDereferenceTerm :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Term stripAndDereferenceTerm graph term = @@ -262,6 +294,7 @@ in case stripped of Core.TermVariable v0 -> Eithers.bind (requireTerm graph v0) (\t -> stripAndDereferenceTerm graph t) _ -> Right stripped + -- | Strip annotations and dereference variables, returning Either an error or the resolved term stripAndDereferenceTermEither :: Graph.Graph -> Core.Term -> Either Errors.Error Core.Term stripAndDereferenceTermEither graph term = 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.chars module. module Hydra.Lib.Chars 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 @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + isAlphaNum :: Packaging.PrimitiveDefinition isAlphaNum = Packaging.PrimitiveDefinition { @@ -53,6 +62,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + isLower :: Packaging.PrimitiveDefinition isLower = Packaging.PrimitiveDefinition { @@ -80,6 +90,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + isSpace :: Packaging.PrimitiveDefinition isSpace = Packaging.PrimitiveDefinition { @@ -106,6 +117,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + isUpper :: Packaging.PrimitiveDefinition isUpper = Packaging.PrimitiveDefinition { @@ -133,6 +145,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toLower :: Packaging.PrimitiveDefinition toLower = Packaging.PrimitiveDefinition { @@ -160,6 +173,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toUpper :: Packaging.PrimitiveDefinition toUpper = Packaging.PrimitiveDefinition { diff --git a/src/main/haskell/Hydra/Lib/Effects.hs b/src/main/haskell/Hydra/Lib/Effects.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Effects.hs @@ -0,0 +1,349 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.effects module. + +module Hydra.Lib.Effects 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 + +apply :: Packaging.PrimitiveDefinition +apply = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.apply"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Applicative apply for effects."), + Packaging.entityMetadataComments = [ + "apply(ef, ex) describes an effectful computation which first interprets ef to produce a function, then interprets ex to produce an argument, and returns the result of applying the function to the argument."], + 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.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.parameterType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +bind :: Packaging.PrimitiveDefinition +bind = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.bind"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Sequence two effectful computations."), + Packaging.entityMetadataComments = [ + "bind(e, f) describes an effectful computation which first interprets e, then passes its result to f to obtain the next effect.", + "Host interpreters provide the operational meaning; Hydra uses the type effect to keep the effect boundary explicit."], + 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.TypeEffect (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + 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.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +compose :: Packaging.PrimitiveDefinition +compose = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.compose"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Kleisli composition for effects."), + Packaging.entityMetadataComments = [ + "compose(f, g, x) describes an effectful computation equivalent to bind(f(x), g)."], + 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 "arg0"), + Typing.parameterDescription = Nothing, + 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.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.parameterType = (Core.TypeVariable (Core.Name "x")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeVariable (Core.Name "z")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +foldl :: Packaging.PrimitiveDefinition +foldl = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.foldl"), + 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."], + 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.TypeFunction (Core.FunctionType { + Core.functionTypeDomain = (Core.TypeVariable (Core.Name "y")), + Core.functionTypeCodomain = (Core.TypeEffect (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.Parameter { + Typing.parameterName = (Core.Name "arg2"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeList (Core.TypeVariable (Core.Name "y"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +map :: Packaging.PrimitiveDefinition +map = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.map"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Map a pure function over the result of an effect."), + Packaging.entityMetadataComments = [ + "map(f, e) describes an effectful computation which interprets e and applies f to its result.", + "Equivalent to bind(e, \\x -> pure(f x))."], + 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.parameterType = (Core.TypeEffect (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeVariable (Core.Name "y")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +mapList :: Packaging.PrimitiveDefinition +mapList = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.mapList"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Map an effect-returning function over a list."), + Packaging.entityMetadataComments = [ + "mapList(f, xs) describes an effectful computation which applies f to each element of xs from left to right and collects the results."], + 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.TypeEffect (Core.TypeVariable (Core.Name "y")))})), + 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.TypeEffect (Core.TypeList (Core.TypeVariable (Core.Name "y"))))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +mapOptional :: Packaging.PrimitiveDefinition +mapOptional = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.mapOptional"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Map an effect-returning function over an optional."), + Packaging.entityMetadataComments = [ + "mapOptional(f, m) describes an effectful computation which returns none when m is none, or applies f to the contained value and wraps the result in given."], + 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.TypeEffect (Core.TypeVariable (Core.Name "y")))})), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x"))), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeOptional (Core.TypeVariable (Core.Name "y"))))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +pure :: Packaging.PrimitiveDefinition +pure = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.effects.pure"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Lift a pure value into an effect."), + Packaging.entityMetadataComments = [ + "pure(x) describes an effectful computation which succeeds with x without requiring host interaction."], + 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.TypeEffect (Core.TypeVariable (Core.Name "x")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.eithers module. module Hydra.Lib.Eithers 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + bimap :: Packaging.PrimitiveDefinition bimap = Packaging.PrimitiveDefinition { @@ -81,37 +89,33 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "w"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "g"), + Core.lambdaParameter = (Core.Name "e"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "y"), + Core.lambdaParameter = (Core.Name "x"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map over both sides of an Either, defined in terms of either.")))]))})))} + 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"))}))}))}))})))} + bind :: Packaging.PrimitiveDefinition bind = Packaging.PrimitiveDefinition { @@ -159,27 +163,23 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "z"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Monadic bind for Either, defined in terms of either.")))]))})))} + 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"))}))}))})))} + either :: Packaging.PrimitiveDefinition either = Packaging.PrimitiveDefinition { @@ -231,6 +231,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + foldl :: Packaging.PrimitiveDefinition foldl = Packaging.PrimitiveDefinition { @@ -283,44 +284,40 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "x"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "acc0"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc0"), + Core.lambdaParameter = (Core.Name "xs"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldl")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Either-short-circuiting left fold, defined in terms of bind.")))]))})))} + 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"))}))}))}))})))} + fromLeft :: Packaging.PrimitiveDefinition fromLeft = Packaging.PrimitiveDefinition { @@ -358,30 +355,26 @@ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), + Core.lambdaParameter = (Core.Name "x"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "def"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Extract the Left value or return a default, defined in terms of either.")))]))})))} + 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 { @@ -419,30 +412,26 @@ Typing.resultType = (Core.TypeVariable (Core.Name "y"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.eithers.either")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "def"))}))})), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + Core.lambdaParameter = (Core.Name "_"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Extract the Right value or return a default, defined in terms of either.")))]))})))} + 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 { @@ -475,27 +464,23 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.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.TermVariable (Core.Name "e"))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Check whether an Either is a Left value, defined in terms of either.")))]))})))} + 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"))}))})))} + isRight :: Packaging.PrimitiveDefinition isRight = Packaging.PrimitiveDefinition { @@ -528,27 +513,23 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.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.TermVariable (Core.Name "e"))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Check whether an Either is a Right value, defined in terms of either.")))]))})))} + 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"))}))})))} + lefts :: Packaging.PrimitiveDefinition lefts = Packaging.PrimitiveDefinition { @@ -581,43 +562,39 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), + Core.lambdaParameter = (Core.Name "l"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Extract all Left values from a list of eithers, defined in terms of either + foldr.")))]))})))} + 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"))}))})))} + map :: Packaging.PrimitiveDefinition map = Packaging.PrimitiveDefinition { @@ -663,32 +640,28 @@ Core.eitherTypeRight = (Core.TypeVariable (Core.Name "y"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "e"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "e"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "y"), + Core.lambdaParameter = (Core.Name "x"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map a function over the Right side, defined in terms of either.")))]))})))} + 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"))}))}))})))} + mapList :: Packaging.PrimitiveDefinition mapList = Packaging.PrimitiveDefinition { @@ -733,50 +706,46 @@ Core.eitherTypeRight = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Traverse a list with an Either-returning function, short-circuiting on Left.")))]))})))} + 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"))}))}))})))} + mapOptional :: Packaging.PrimitiveDefinition mapOptional = Packaging.PrimitiveDefinition { @@ -821,36 +790,32 @@ Core.eitherTypeRight = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "m"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Traverse an Optional with an Either-returning function.")))]))})))} + 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"))}))}))}))}))}))})))} + mapSet :: Packaging.PrimitiveDefinition mapSet = Packaging.PrimitiveDefinition { @@ -895,61 +860,57 @@ Core.eitherTypeRight = (Core.TypeSet (Core.TypeVariable (Core.Name "y")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Traverse a Set with an Either-returning function, defined via list+set conversion.")))]))})))} + 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"))}))}))}))}))})))} + partitionEithers :: Packaging.PrimitiveDefinition partitionEithers = Packaging.PrimitiveDefinition { @@ -984,59 +945,55 @@ Core.pairTypeSecond = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "r"), + Core.lambdaParameter = (Core.Name "l"), 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.TermVariable (Core.Name "l"))})), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Partition a list of eithers into (lefts, rights), defined in terms of either + foldr.")))]))})))} + 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"))}))})))} + rights :: Packaging.PrimitiveDefinition rights = Packaging.PrimitiveDefinition { @@ -1069,40 +1026,35 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.eithers.either")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "_"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "acc"))}))})), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.eithers.either")), Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "r"), + Core.lambdaParameter = (Core.Name "_"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Extract all Right values from a list of eithers, defined in terms of either + foldr.")))]))})))} + 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"))}))})))} 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.equality module. module Hydra.Lib.Equality 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + compare :: Packaging.PrimitiveDefinition compare = Packaging.PrimitiveDefinition { @@ -63,6 +71,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + equal :: Packaging.PrimitiveDefinition equal = Packaging.PrimitiveDefinition { @@ -99,6 +108,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + gt :: Packaging.PrimitiveDefinition gt = Packaging.PrimitiveDefinition { @@ -134,6 +144,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + gte :: Packaging.PrimitiveDefinition gte = Packaging.PrimitiveDefinition { @@ -169,6 +180,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + identity :: Packaging.PrimitiveDefinition identity = Packaging.PrimitiveDefinition { @@ -196,13 +208,11 @@ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "Return a value unchanged.")))]))})))} + 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 { @@ -238,6 +248,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + lte :: Packaging.PrimitiveDefinition lte = Packaging.PrimitiveDefinition { @@ -273,6 +284,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + max :: Packaging.PrimitiveDefinition max = Packaging.PrimitiveDefinition { @@ -307,28 +319,24 @@ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "y"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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"))}))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Return the maximum of two values, defined in terms of gte and ifElse.")))]))})))} + 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 { @@ -363,25 +371,20 @@ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "y"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Return the minimum of two values, defined in terms of lte and ifElse.")))]))})))} + 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"))}))}))})))} diff --git a/src/main/haskell/Hydra/Lib/Files.hs b/src/main/haskell/Hydra/Lib/Files.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Files.hs @@ -0,0 +1,368 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.files module. + +module Hydra.Lib.Files 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 + +appendFile :: Packaging.PrimitiveDefinition +appendFile = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.appendFile"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Append bytes to the end of a file."), + Packaging.entityMetadataComments = [ + "appendFile(path, contents) describes an effectful computation which attempts to append the raw bytes contents to the end of the file at path, creating the file if it does not exist. Unlike writeFile, existing contents are preserved. File I/O is byte-oriented; to append text, encode it to bytes first (e.g. via hydra.lib.text.encodeUtf8). A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +copy :: Packaging.PrimitiveDefinition +copy = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.copy"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Copy a file, or a directory tree, to a destination path."), + Packaging.entityMetadataComments = [ + "copy(recursive, source, destination) describes an effectful computation which attempts to copy source to destination. When recursive is false, source must be a single file. When recursive is true, source may be a directory, whose entire tree is copied. Copying is performed by the host operating system rather than by reading and rewriting contents, preserving binary data and avoiding a round trip through the language runtime. A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg2"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +createDirectory :: Packaging.PrimitiveDefinition +createDirectory = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.createDirectory"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Create a directory."), + Packaging.entityMetadataComments = [ + "createDirectory(recursive, path) describes an effectful computation which attempts to create a directory at path. When recursive is false this corresponds to POSIX mkdir: it fails if path already exists or if a parent is missing. When recursive is true, any missing parent directories are created as well (as with mkdir -p) and an already-existing directory is not an error. A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +exists :: Packaging.PrimitiveDefinition +exists = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.exists"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Test whether a path exists."), + Packaging.entityMetadataComments = [ + "exists(path) describes an effectful computation which reports whether anything exists at path, whether a file, directory, or other type of file. It does not error when the path is absent; a missing path is reported as right(false). Use status to obtain the type of an existing path. A recoverable file-system failure is returned as left(error)."], + 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.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = (Core.TypeLiteral Core.LiteralTypeBoolean)})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +listDirectory :: Packaging.PrimitiveDefinition +listDirectory = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.listDirectory"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "List the immediate entries of a directory."), + Packaging.entityMetadataComments = [ + "listDirectory(path) describes an effectful computation which returns the immediate entries of the directory at path, excluding the special entries \".\" and \"..\". The result is one level deep and is not ordered; to traverse a tree recursively, recurse using status. A recoverable file-system failure is returned as left(error)."], + 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.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = (Core.TypeList (Core.TypeVariable (Core.Name "hydra.file.FilePath")))})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +readFile :: Packaging.PrimitiveDefinition +readFile = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.readFile"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Read the complete contents of a file as raw bytes."), + Packaging.entityMetadataComments = [ + "readFile(path) describes an effectful computation which attempts to read the entire contents of the file at path as raw bytes, with no character decoding or newline translation. To interpret the result as text, decode it (e.g. via hydra.lib.text.decodeUtf8). A recoverable file-system failure is returned as left(error); success is returned as right(contents)."], + 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.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = (Core.TypeLiteral Core.LiteralTypeBinary)})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +removeDirectory :: Packaging.PrimitiveDefinition +removeDirectory = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.removeDirectory"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Remove a directory."), + Packaging.entityMetadataComments = [ + "removeDirectory(recursive, path) describes an effectful computation which attempts to remove the directory at path. When recursive is false this corresponds to POSIX rmdir: it fails unless the directory is empty. When recursive is true, the directory and its entire contents are removed (as with rm -r). Removal is performed by the host operating system rather than by walking and deleting entries individually. A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeLiteral Core.LiteralTypeBoolean), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +removeFile :: Packaging.PrimitiveDefinition +removeFile = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.removeFile"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Remove a file."), + Packaging.entityMetadataComments = [ + "removeFile(path) describes an effectful computation which attempts to remove the file at path (POSIX unlink). A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +rename :: Packaging.PrimitiveDefinition +rename = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.rename"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Rename or move a file or directory."), + Packaging.entityMetadataComments = [ + "rename(source, destination) describes an effectful computation which attempts to rename the file or directory at source to destination. When source and destination are on the same file system this is atomic (POSIX rename) and cannot be reproduced by a copy followed by a delete. A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +status :: Packaging.PrimitiveDefinition +status = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.status"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Retrieve metadata about a file or directory."), + Packaging.entityMetadataComments = [ + "status(path) describes an effectful computation which retrieves metadata about the file at path (POSIX stat), including its type, size, and modification time. Symbolic links are followed. A path which does not exist yields left(notFound); other recoverable file-system failures are also returned as left(error). Use exists for a boolean presence check that does not error on absence."], + 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.TypeVariable (Core.Name "hydra.file.FilePath")), + 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.file.FileError")), + Core.eitherTypeRight = (Core.TypeVariable (Core.Name "hydra.file.FileStatus"))})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +writeFile :: Packaging.PrimitiveDefinition +writeFile = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.files.writeFile"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Write raw bytes as the complete contents of a file."), + Packaging.entityMetadataComments = [ + "writeFile(path, contents) describes an effectful computation which attempts to replace the file at path with the raw bytes contents, with no character encoding or newline translation. To write text, encode it to bytes first (e.g. via hydra.lib.text.encodeUtf8). A recoverable file-system failure 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 "arg0"), + Typing.parameterDescription = Nothing, + Typing.parameterType = (Core.TypeVariable (Core.Name "hydra.file.FilePath")), + Typing.parameterIsLazy = False}, + Typing.Parameter { + Typing.parameterName = (Core.Name "arg1"), + Typing.parameterDescription = Nothing, + 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.file.FileError")), + Core.eitherTypeRight = Core.TypeUnit})))}}, + Packaging.primitiveDefinitionIsPure = False, + 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.lists module. module Hydra.Lib.Lists 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + apply :: Packaging.PrimitiveDefinition apply = Packaging.PrimitiveDefinition { @@ -66,6 +74,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bind :: Packaging.PrimitiveDefinition bind = Packaging.PrimitiveDefinition { @@ -103,36 +112,32 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Monadic bind (concatMap) for lists, defined in terms of foldr and concat2.")))]))})))} + 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"))}))}))})))} + concat :: Packaging.PrimitiveDefinition concat = Packaging.PrimitiveDefinition { @@ -161,6 +166,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + concat2 :: Packaging.PrimitiveDefinition concat2 = Packaging.PrimitiveDefinition { @@ -194,6 +200,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + cons :: Packaging.PrimitiveDefinition cons = Packaging.PrimitiveDefinition { @@ -227,6 +234,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + drop :: Packaging.PrimitiveDefinition drop = Packaging.PrimitiveDefinition { @@ -260,6 +268,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + dropWhile :: Packaging.PrimitiveDefinition dropWhile = Packaging.PrimitiveDefinition { @@ -294,24 +303,20 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Drop the leading run satisfying a predicate, defined as the suffix component of span.")))]))})))} + 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"))}))}))}))})))} + elem :: Packaging.PrimitiveDefinition elem = Packaging.PrimitiveDefinition { @@ -347,6 +352,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + filter :: Packaging.PrimitiveDefinition filter = Packaging.PrimitiveDefinition { @@ -381,42 +387,38 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.logic.ifElse")), - 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.logic.ifElse")), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Filter a list by a predicate, defined in terms of foldr.")))]))})))} + 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"))}))}))})))} + find :: Packaging.PrimitiveDefinition find = Packaging.PrimitiveDefinition { @@ -451,38 +453,34 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Find the first matching element, defined in terms of foldr.")))]))})))} + 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"))}))}))})))} + foldl :: Packaging.PrimitiveDefinition foldl = Packaging.PrimitiveDefinition { @@ -529,6 +527,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + foldr :: Packaging.PrimitiveDefinition foldr = Packaging.PrimitiveDefinition { @@ -574,6 +573,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + group :: Packaging.PrimitiveDefinition group = Packaging.PrimitiveDefinition { @@ -604,6 +604,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + intercalate :: Packaging.PrimitiveDefinition intercalate = Packaging.PrimitiveDefinition { @@ -637,6 +638,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + intersperse :: Packaging.PrimitiveDefinition intersperse = Packaging.PrimitiveDefinition { @@ -670,6 +672,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + length :: Packaging.PrimitiveDefinition length = Packaging.PrimitiveDefinition { @@ -699,6 +702,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + map :: Packaging.PrimitiveDefinition map = Packaging.PrimitiveDefinition { @@ -737,6 +741,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeAt :: Packaging.PrimitiveDefinition maybeAt = Packaging.PrimitiveDefinition { @@ -770,6 +775,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeHead :: Packaging.PrimitiveDefinition maybeHead = Packaging.PrimitiveDefinition { @@ -798,6 +804,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeInit :: Packaging.PrimitiveDefinition maybeInit = Packaging.PrimitiveDefinition { @@ -826,6 +833,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeLast :: Packaging.PrimitiveDefinition maybeLast = Packaging.PrimitiveDefinition { @@ -854,6 +862,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeTail :: Packaging.PrimitiveDefinition maybeTail = Packaging.PrimitiveDefinition { @@ -882,6 +891,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + nub :: Packaging.PrimitiveDefinition nub = Packaging.PrimitiveDefinition { @@ -913,6 +923,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + null :: Packaging.PrimitiveDefinition null = Packaging.PrimitiveDefinition { @@ -941,6 +952,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + partition :: Packaging.PrimitiveDefinition partition = Packaging.PrimitiveDefinition { @@ -977,58 +989,54 @@ Core.pairTypeSecond = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Partition a list by a predicate, defined in terms of foldr over a pair of accumulators.")))]))})))} + 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"))}))}))})))} + pure :: Packaging.PrimitiveDefinition pure = Packaging.PrimitiveDefinition { @@ -1057,6 +1065,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + replicate :: Packaging.PrimitiveDefinition replicate = Packaging.PrimitiveDefinition { @@ -1090,6 +1099,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + reverse :: Packaging.PrimitiveDefinition reverse = Packaging.PrimitiveDefinition { @@ -1118,6 +1128,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + singleton :: Packaging.PrimitiveDefinition singleton = Packaging.PrimitiveDefinition { @@ -1146,6 +1157,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sort :: Packaging.PrimitiveDefinition sort = Packaging.PrimitiveDefinition { @@ -1176,6 +1188,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sortOn :: Packaging.PrimitiveDefinition sortOn = Packaging.PrimitiveDefinition { @@ -1216,6 +1229,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + span :: Packaging.PrimitiveDefinition span = Packaging.PrimitiveDefinition { @@ -1252,64 +1266,60 @@ Core.pairTypeSecond = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldr")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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 "p")), - Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + 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.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.applicationFunction = (Core.TermVariable (Core.Name "p")), + Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})), + 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.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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Split a list at the first predicate failure, defined in terms of foldr over a pair.")))]))})))} + 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.TermList [], + (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"))}))}))})))} + take :: Packaging.PrimitiveDefinition take = Packaging.PrimitiveDefinition { @@ -1343,6 +1353,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + transpose :: Packaging.PrimitiveDefinition transpose = Packaging.PrimitiveDefinition { @@ -1371,6 +1382,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + uncons :: Packaging.PrimitiveDefinition uncons = Packaging.PrimitiveDefinition { @@ -1401,6 +1413,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + zip :: Packaging.PrimitiveDefinition zip = Packaging.PrimitiveDefinition { @@ -1439,6 +1452,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + zipWith :: Packaging.PrimitiveDefinition zipWith = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.literals module. module Hydra.Lib.Literals 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 @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + bigintToDecimal :: Packaging.PrimitiveDefinition bigintToDecimal = Packaging.PrimitiveDefinition { @@ -51,6 +60,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToInt16 :: Packaging.PrimitiveDefinition bigintToInt16 = Packaging.PrimitiveDefinition { @@ -76,6 +86,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToInt32 :: Packaging.PrimitiveDefinition bigintToInt32 = Packaging.PrimitiveDefinition { @@ -101,6 +112,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToInt64 :: Packaging.PrimitiveDefinition bigintToInt64 = Packaging.PrimitiveDefinition { @@ -126,6 +138,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToInt8 :: Packaging.PrimitiveDefinition bigintToInt8 = Packaging.PrimitiveDefinition { @@ -151,6 +164,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToUint16 :: Packaging.PrimitiveDefinition bigintToUint16 = Packaging.PrimitiveDefinition { @@ -176,6 +190,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToUint32 :: Packaging.PrimitiveDefinition bigintToUint32 = Packaging.PrimitiveDefinition { @@ -201,6 +216,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToUint64 :: Packaging.PrimitiveDefinition bigintToUint64 = Packaging.PrimitiveDefinition { @@ -226,6 +242,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + bigintToUint8 :: Packaging.PrimitiveDefinition bigintToUint8 = Packaging.PrimitiveDefinition { @@ -251,6 +268,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + binaryToBytes :: Packaging.PrimitiveDefinition binaryToBytes = Packaging.PrimitiveDefinition { @@ -277,6 +295,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + binaryToString :: Packaging.PrimitiveDefinition binaryToString = Packaging.PrimitiveDefinition { @@ -303,6 +322,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + decimalToBigint :: Packaging.PrimitiveDefinition decimalToBigint = Packaging.PrimitiveDefinition { @@ -328,6 +348,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + decimalToFloat32 :: Packaging.PrimitiveDefinition decimalToFloat32 = Packaging.PrimitiveDefinition { @@ -353,6 +374,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + decimalToFloat64 :: Packaging.PrimitiveDefinition decimalToFloat64 = Packaging.PrimitiveDefinition { @@ -378,6 +400,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + float32ToDecimal :: Packaging.PrimitiveDefinition float32ToDecimal = Packaging.PrimitiveDefinition { @@ -403,6 +426,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + float32ToFloat64 :: Packaging.PrimitiveDefinition float32ToFloat64 = Packaging.PrimitiveDefinition { @@ -428,6 +452,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + float64ToDecimal :: Packaging.PrimitiveDefinition float64ToDecimal = Packaging.PrimitiveDefinition { @@ -453,6 +478,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + float64ToFloat32 :: Packaging.PrimitiveDefinition float64ToFloat32 = Packaging.PrimitiveDefinition { @@ -478,6 +504,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + int16ToBigint :: Packaging.PrimitiveDefinition int16ToBigint = Packaging.PrimitiveDefinition { @@ -503,6 +530,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + int32ToBigint :: Packaging.PrimitiveDefinition int32ToBigint = Packaging.PrimitiveDefinition { @@ -528,6 +556,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + int64ToBigint :: Packaging.PrimitiveDefinition int64ToBigint = Packaging.PrimitiveDefinition { @@ -553,6 +582,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + int8ToBigint :: Packaging.PrimitiveDefinition int8ToBigint = Packaging.PrimitiveDefinition { @@ -578,6 +608,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readBigint :: Packaging.PrimitiveDefinition readBigint = Packaging.PrimitiveDefinition { @@ -604,6 +635,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readBoolean :: Packaging.PrimitiveDefinition readBoolean = Packaging.PrimitiveDefinition { @@ -629,6 +661,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readDecimal :: Packaging.PrimitiveDefinition readDecimal = Packaging.PrimitiveDefinition { @@ -655,6 +688,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readFloat32 :: Packaging.PrimitiveDefinition readFloat32 = Packaging.PrimitiveDefinition { @@ -681,6 +715,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readFloat64 :: Packaging.PrimitiveDefinition readFloat64 = Packaging.PrimitiveDefinition { @@ -707,6 +742,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readInt16 :: Packaging.PrimitiveDefinition readInt16 = Packaging.PrimitiveDefinition { @@ -732,6 +768,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readInt32 :: Packaging.PrimitiveDefinition readInt32 = Packaging.PrimitiveDefinition { @@ -757,6 +794,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readInt64 :: Packaging.PrimitiveDefinition readInt64 = Packaging.PrimitiveDefinition { @@ -782,6 +820,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readInt8 :: Packaging.PrimitiveDefinition readInt8 = Packaging.PrimitiveDefinition { @@ -807,6 +846,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readString :: Packaging.PrimitiveDefinition readString = Packaging.PrimitiveDefinition { @@ -832,6 +872,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readUint16 :: Packaging.PrimitiveDefinition readUint16 = Packaging.PrimitiveDefinition { @@ -857,6 +898,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readUint32 :: Packaging.PrimitiveDefinition readUint32 = Packaging.PrimitiveDefinition { @@ -882,6 +924,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readUint64 :: Packaging.PrimitiveDefinition readUint64 = Packaging.PrimitiveDefinition { @@ -907,6 +950,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + readUint8 :: Packaging.PrimitiveDefinition readUint8 = Packaging.PrimitiveDefinition { @@ -932,6 +976,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showBigint :: Packaging.PrimitiveDefinition showBigint = Packaging.PrimitiveDefinition { @@ -957,6 +1002,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showBoolean :: Packaging.PrimitiveDefinition showBoolean = Packaging.PrimitiveDefinition { @@ -982,6 +1028,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showDecimal :: Packaging.PrimitiveDefinition showDecimal = Packaging.PrimitiveDefinition { @@ -1007,6 +1054,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showFloat32 :: Packaging.PrimitiveDefinition showFloat32 = Packaging.PrimitiveDefinition { @@ -1032,6 +1080,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showFloat64 :: Packaging.PrimitiveDefinition showFloat64 = Packaging.PrimitiveDefinition { @@ -1057,6 +1106,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showInt16 :: Packaging.PrimitiveDefinition showInt16 = Packaging.PrimitiveDefinition { @@ -1082,6 +1132,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showInt32 :: Packaging.PrimitiveDefinition showInt32 = Packaging.PrimitiveDefinition { @@ -1107,6 +1158,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showInt64 :: Packaging.PrimitiveDefinition showInt64 = Packaging.PrimitiveDefinition { @@ -1132,6 +1184,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showInt8 :: Packaging.PrimitiveDefinition showInt8 = Packaging.PrimitiveDefinition { @@ -1157,6 +1210,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showString :: Packaging.PrimitiveDefinition showString = Packaging.PrimitiveDefinition { @@ -1182,6 +1236,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showUint16 :: Packaging.PrimitiveDefinition showUint16 = Packaging.PrimitiveDefinition { @@ -1207,6 +1262,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showUint32 :: Packaging.PrimitiveDefinition showUint32 = Packaging.PrimitiveDefinition { @@ -1232,6 +1288,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showUint64 :: Packaging.PrimitiveDefinition showUint64 = Packaging.PrimitiveDefinition { @@ -1257,6 +1314,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + showUint8 :: Packaging.PrimitiveDefinition showUint8 = Packaging.PrimitiveDefinition { @@ -1282,6 +1340,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + stringToBinary :: Packaging.PrimitiveDefinition stringToBinary = Packaging.PrimitiveDefinition { @@ -1307,6 +1366,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + uint16ToBigint :: Packaging.PrimitiveDefinition uint16ToBigint = Packaging.PrimitiveDefinition { @@ -1332,6 +1392,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + uint32ToBigint :: Packaging.PrimitiveDefinition uint32ToBigint = Packaging.PrimitiveDefinition { @@ -1357,6 +1418,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + uint64ToBigint :: Packaging.PrimitiveDefinition uint64ToBigint = Packaging.PrimitiveDefinition { @@ -1382,6 +1444,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + uint8ToBigint :: Packaging.PrimitiveDefinition uint8ToBigint = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.logic module. module Hydra.Lib.Logic 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + and :: Packaging.PrimitiveDefinition and = Packaging.PrimitiveDefinition { @@ -57,24 +65,20 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "a"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "b"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Logical AND, defined in terms of ifElse.")))]))})))} + 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))}))}))})))} + ifElse :: Packaging.PrimitiveDefinition ifElse = Packaging.PrimitiveDefinition { @@ -114,6 +118,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + not :: Packaging.PrimitiveDefinition not = Packaging.PrimitiveDefinition { @@ -138,21 +143,17 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "a"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Logical NOT, defined in terms of ifElse.")))]))})))} + 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))}))})))} + or :: Packaging.PrimitiveDefinition or = Packaging.PrimitiveDefinition { @@ -183,21 +184,16 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "a"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "b"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Logical OR, defined in terms of ifElse.")))]))})))} + 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"))}))}))})))} 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.maps module. module Hydra.Lib.Maps 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + alter :: Packaging.PrimitiveDefinition alter = Packaging.PrimitiveDefinition { @@ -76,46 +84,42 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "k"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "k"), + Core.lambdaParameter = (Core.Name "m"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cases")), 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.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.insert")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.lookup")), Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "vNew"))})), - Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "alter, defined in terms of lookup/insert/delete via optionals.cases.")))]))})))} + 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"))}))}))}))}))}))})))} + bimap :: Packaging.PrimitiveDefinition bimap = Packaging.PrimitiveDefinition { @@ -174,42 +178,38 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v2"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "fk"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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 "fv"), + Core.lambdaParameter = (Core.Name "m"), 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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "bimap on a map, defined via toList/fromList.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))})))} + delete :: Packaging.PrimitiveDefinition delete = Packaging.PrimitiveDefinition { @@ -252,6 +252,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + elems :: Packaging.PrimitiveDefinition elems = Packaging.PrimitiveDefinition { @@ -287,6 +288,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + empty :: Packaging.PrimitiveDefinition empty = Packaging.PrimitiveDefinition { @@ -317,6 +319,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + filter :: Packaging.PrimitiveDefinition filter = Packaging.PrimitiveDefinition { @@ -360,33 +363,29 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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 "m"), 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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "filter on a map, defined via toList/fromList.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))})))} + filterWithKey :: Packaging.PrimitiveDefinition filterWithKey = Packaging.PrimitiveDefinition { @@ -432,37 +431,33 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "p"), + 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 "m"), 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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "filterWithKey on a map, defined via toList/fromList.")))]))})))} + 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"))}))}))}))}))})))} + findWithDefault :: Packaging.PrimitiveDefinition findWithDefault = Packaging.PrimitiveDefinition { @@ -507,29 +502,25 @@ Typing.resultType = (Core.TypeVariable (Core.Name "v"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), + 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 "k"), Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "k"), + Core.lambdaParameter = (Core.Name "m"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.fromOptional")), + 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.optionals.fromOptional")), - 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "findWithDefault, defined in terms of lookup + fromOptional.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.lookup")), + Core.applicationArgument = (Core.TermVariable (Core.Name "k"))})), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))})))} + fromList :: Packaging.PrimitiveDefinition fromList = Packaging.PrimitiveDefinition { @@ -567,6 +558,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + insert :: Packaging.PrimitiveDefinition insert = Packaging.PrimitiveDefinition { @@ -614,6 +606,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + keys :: Packaging.PrimitiveDefinition keys = Packaging.PrimitiveDefinition { @@ -649,6 +642,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + lookup :: Packaging.PrimitiveDefinition lookup = Packaging.PrimitiveDefinition { @@ -689,6 +683,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + map :: Packaging.PrimitiveDefinition map = Packaging.PrimitiveDefinition { @@ -735,37 +730,33 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v2"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "m"), 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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "map over values, defined via toList/fromList.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))})))} + mapKeys :: Packaging.PrimitiveDefinition mapKeys = Packaging.PrimitiveDefinition { @@ -813,37 +804,33 @@ Core.mapTypeValues = (Core.TypeVariable (Core.Name "v"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "m"), 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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "map over keys, defined via toList/fromList.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))})))} + member :: Packaging.PrimitiveDefinition member = Packaging.PrimitiveDefinition { @@ -884,6 +871,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + null :: Packaging.PrimitiveDefinition null = Packaging.PrimitiveDefinition { @@ -919,6 +907,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + singleton :: Packaging.PrimitiveDefinition singleton = Packaging.PrimitiveDefinition { @@ -959,6 +948,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + size :: Packaging.PrimitiveDefinition size = Packaging.PrimitiveDefinition { @@ -994,6 +984,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toList :: Packaging.PrimitiveDefinition toList = Packaging.PrimitiveDefinition { @@ -1031,6 +1022,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + union :: Packaging.PrimitiveDefinition union = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.math module. module Hydra.Lib.Math 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + abs :: Packaging.PrimitiveDefinition abs = Packaging.PrimitiveDefinition { @@ -53,6 +61,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + acos :: Packaging.PrimitiveDefinition acos = Packaging.PrimitiveDefinition { @@ -79,6 +88,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + acosh :: Packaging.PrimitiveDefinition acosh = Packaging.PrimitiveDefinition { @@ -105,6 +115,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + add :: Packaging.PrimitiveDefinition add = Packaging.PrimitiveDefinition { @@ -135,6 +146,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + addFloat64 :: Packaging.PrimitiveDefinition addFloat64 = Packaging.PrimitiveDefinition { @@ -166,6 +178,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + asin :: Packaging.PrimitiveDefinition asin = Packaging.PrimitiveDefinition { @@ -192,6 +205,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + asinh :: Packaging.PrimitiveDefinition asinh = Packaging.PrimitiveDefinition { @@ -217,6 +231,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + atan :: Packaging.PrimitiveDefinition atan = Packaging.PrimitiveDefinition { @@ -242,6 +257,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + atan2 :: Packaging.PrimitiveDefinition atan2 = Packaging.PrimitiveDefinition { @@ -273,6 +289,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + atanh :: Packaging.PrimitiveDefinition atanh = Packaging.PrimitiveDefinition { @@ -298,6 +315,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + ceiling :: Packaging.PrimitiveDefinition ceiling = Packaging.PrimitiveDefinition { @@ -324,6 +342,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + cos :: Packaging.PrimitiveDefinition cos = Packaging.PrimitiveDefinition { @@ -349,6 +368,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + cosh :: Packaging.PrimitiveDefinition cosh = Packaging.PrimitiveDefinition { @@ -374,6 +394,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + e :: Packaging.PrimitiveDefinition e = Packaging.PrimitiveDefinition { @@ -394,6 +415,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + even :: Packaging.PrimitiveDefinition even = Packaging.PrimitiveDefinition { @@ -418,27 +440,23 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (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")), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.fromOptional")), + 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.optionals.fromOptional")), - 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Test whether an integer is even, defined via maybeMod and equality.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.maybeMod")), + 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)))}))})))} + exp :: Packaging.PrimitiveDefinition exp = Packaging.PrimitiveDefinition { @@ -464,6 +482,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + floor :: Packaging.PrimitiveDefinition floor = Packaging.PrimitiveDefinition { @@ -490,6 +509,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + log :: Packaging.PrimitiveDefinition log = Packaging.PrimitiveDefinition { @@ -515,6 +535,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + logBase :: Packaging.PrimitiveDefinition logBase = Packaging.PrimitiveDefinition { @@ -546,6 +567,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + max :: Packaging.PrimitiveDefinition max = Packaging.PrimitiveDefinition { @@ -576,6 +598,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeDiv :: Packaging.PrimitiveDefinition maybeDiv = Packaging.PrimitiveDefinition { @@ -608,6 +631,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeMod :: Packaging.PrimitiveDefinition maybeMod = Packaging.PrimitiveDefinition { @@ -639,6 +663,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybePred :: Packaging.PrimitiveDefinition maybePred = Packaging.PrimitiveDefinition { @@ -664,6 +689,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeRem :: Packaging.PrimitiveDefinition maybeRem = Packaging.PrimitiveDefinition { @@ -696,6 +722,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeSucc :: Packaging.PrimitiveDefinition maybeSucc = Packaging.PrimitiveDefinition { @@ -721,6 +748,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + min :: Packaging.PrimitiveDefinition min = Packaging.PrimitiveDefinition { @@ -751,6 +779,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + mul :: Packaging.PrimitiveDefinition mul = Packaging.PrimitiveDefinition { @@ -781,6 +810,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + mulFloat64 :: Packaging.PrimitiveDefinition mulFloat64 = Packaging.PrimitiveDefinition { @@ -812,6 +842,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + negate :: Packaging.PrimitiveDefinition negate = Packaging.PrimitiveDefinition { @@ -838,6 +869,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + negateFloat64 :: Packaging.PrimitiveDefinition negateFloat64 = Packaging.PrimitiveDefinition { @@ -863,6 +895,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + odd :: Packaging.PrimitiveDefinition odd = Packaging.PrimitiveDefinition { @@ -887,19 +920,15 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Test whether an integer is odd, defined as the negation of even.")))]))})))} + Packaging.primitiveDefinitionDefaultImplementation = (Just (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"))}))}))})))} + pi :: Packaging.PrimitiveDefinition pi = Packaging.PrimitiveDefinition { @@ -920,6 +949,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + pow :: Packaging.PrimitiveDefinition pow = Packaging.PrimitiveDefinition { @@ -951,6 +981,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + range :: Packaging.PrimitiveDefinition range = Packaging.PrimitiveDefinition { @@ -981,6 +1012,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + round :: Packaging.PrimitiveDefinition round = Packaging.PrimitiveDefinition { @@ -1007,6 +1039,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + roundFloat32 :: Packaging.PrimitiveDefinition roundFloat32 = Packaging.PrimitiveDefinition { @@ -1038,6 +1071,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + roundFloat64 :: Packaging.PrimitiveDefinition roundFloat64 = Packaging.PrimitiveDefinition { @@ -1069,6 +1103,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + signum :: Packaging.PrimitiveDefinition signum = Packaging.PrimitiveDefinition { @@ -1095,6 +1130,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sin :: Packaging.PrimitiveDefinition sin = Packaging.PrimitiveDefinition { @@ -1120,6 +1156,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sinh :: Packaging.PrimitiveDefinition sinh = Packaging.PrimitiveDefinition { @@ -1145,6 +1182,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sqrt :: Packaging.PrimitiveDefinition sqrt = Packaging.PrimitiveDefinition { @@ -1171,6 +1209,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + sub :: Packaging.PrimitiveDefinition sub = Packaging.PrimitiveDefinition { @@ -1201,6 +1240,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + subFloat64 :: Packaging.PrimitiveDefinition subFloat64 = Packaging.PrimitiveDefinition { @@ -1232,6 +1272,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + tan :: Packaging.PrimitiveDefinition tan = Packaging.PrimitiveDefinition { @@ -1257,6 +1298,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + tanh :: Packaging.PrimitiveDefinition tanh = Packaging.PrimitiveDefinition { @@ -1282,6 +1324,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + truncate :: Packaging.PrimitiveDefinition truncate = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.optionals module. module Hydra.Lib.Optionals 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + apply :: Packaging.PrimitiveDefinition apply = Packaging.PrimitiveDefinition { @@ -65,34 +73,30 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "mf"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Applicative apply for optionals, defined in terms of bind and map.")))]))})))} + 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"))}))}))}))}))})))} + bind :: Packaging.PrimitiveDefinition bind = Packaging.PrimitiveDefinition { @@ -131,24 +135,20 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.optionals.cases")), - Core.applicationArgument = (Core.TermVariable (Core.Name "m"))})), - Core.applicationArgument = (Core.TermOptional Nothing)})), - Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Monadic bind for optionals, defined in terms of cases.")))]))})))} + 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"))}))}))})))} + cases :: Packaging.PrimitiveDefinition cases = Packaging.PrimitiveDefinition { @@ -193,6 +193,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + cat :: Packaging.PrimitiveDefinition cat = Packaging.PrimitiveDefinition { @@ -220,40 +221,36 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "xs"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Catenate a list of optionals, keeping only the present values.")))]))})))} + 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 { @@ -302,27 +299,23 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "z")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "g"), + Core.lambdaParameter = (Core.Name "x"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Kleisli composition for optionals, defined in terms of bind.")))]))})))} + 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"))}))}))}))})))} + fromOptional :: Packaging.PrimitiveDefinition fromOptional = Packaging.PrimitiveDefinition { @@ -355,27 +348,23 @@ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "def"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Return the contained value or a default, defined in terms of cases.")))]))})))} + 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"))}))}))}))})))} + isGiven :: Packaging.PrimitiveDefinition isGiven = Packaging.PrimitiveDefinition { @@ -403,24 +392,20 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Test for presence, defined in terms of cases.")))]))})))} + 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))}))}))})))} + isNone :: Packaging.PrimitiveDefinition isNone = Packaging.PrimitiveDefinition { @@ -448,24 +433,20 @@ Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Test for absence, defined in terms of cases.")))]))})))} + 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))}))}))})))} + map :: Packaging.PrimitiveDefinition map = Packaging.PrimitiveDefinition { @@ -504,29 +485,25 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "m"), Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map a function over an optional, defined in terms of cases.")))]))})))} + 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"))}))))}))}))}))})))} + mapOptional :: Packaging.PrimitiveDefinition mapOptional = Packaging.PrimitiveDefinition { @@ -564,24 +541,20 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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.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.cat")), - 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map a partial function and keep only the present results, defined in terms of lists.map and cat.")))]))})))} + Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.cat")), + 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"))}))}))}))})))} + pure :: Packaging.PrimitiveDefinition pure = Packaging.PrimitiveDefinition { @@ -609,13 +582,11 @@ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "x"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermOptional (Just (Core.TermVariable (Core.Name "x"))))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - (Core.TermVariable (Core.Name "description"), (Core.TermLiteral (Core.LiteralString "Wrap a value in given.")))]))})))} + Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermLambda (Core.Lambda { + Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, + Core.lambdaBody = (Core.TermOptional (Just (Core.TermVariable (Core.Name "x"))))})))} + toList :: Packaging.PrimitiveDefinition toList = Packaging.PrimitiveDefinition { @@ -643,22 +614,17 @@ Typing.resultType = (Core.TypeList (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "m"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Convert an optional to a list, defined in terms of cases.")))]))})))} + 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")])}))}))})))} 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.pairs module. module Hydra.Lib.Pairs 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + bimap :: Packaging.PrimitiveDefinition bimap = Packaging.PrimitiveDefinition { @@ -81,31 +89,27 @@ Core.pairTypeSecond = (Core.TypeVariable (Core.Name "d"))}))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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 "g"), + Core.lambdaParameter = (Core.Name "p"), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map over both elements of a pair, defined in terms of first and second.")))]))})))} + 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"))}))}))))}))}))})))} + first :: Packaging.PrimitiveDefinition first = Packaging.PrimitiveDefinition { @@ -139,6 +143,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + second :: Packaging.PrimitiveDefinition second = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.regex module. module Hydra.Lib.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.Packaging as Packaging @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + find :: Packaging.PrimitiveDefinition find = Packaging.PrimitiveDefinition { @@ -57,6 +66,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + findAll :: Packaging.PrimitiveDefinition findAll = Packaging.PrimitiveDefinition { @@ -88,6 +98,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + matches :: Packaging.PrimitiveDefinition matches = Packaging.PrimitiveDefinition { @@ -119,6 +130,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + replace :: Packaging.PrimitiveDefinition replace = Packaging.PrimitiveDefinition { @@ -156,6 +168,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + replaceAll :: Packaging.PrimitiveDefinition replaceAll = Packaging.PrimitiveDefinition { @@ -192,6 +205,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + split :: Packaging.PrimitiveDefinition split = Packaging.PrimitiveDefinition { 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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.sets module. module Hydra.Lib.Sets 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 @@ -16,8 +22,10 @@ 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 @@ -26,7 +34,7 @@ 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 + delete :: Packaging.PrimitiveDefinition delete = Packaging.PrimitiveDefinition { @@ -62,6 +70,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + difference :: Packaging.PrimitiveDefinition difference = Packaging.PrimitiveDefinition { @@ -96,46 +105,42 @@ Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s1"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s2"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldl")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "el"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Set difference, defined in terms of member and insert.")))]))})))} + 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"))}))}))}))})))} + empty :: Packaging.PrimitiveDefinition empty = Packaging.PrimitiveDefinition { @@ -161,6 +166,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + fromList :: Packaging.PrimitiveDefinition fromList = Packaging.PrimitiveDefinition { @@ -191,6 +197,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + insert :: Packaging.PrimitiveDefinition insert = Packaging.PrimitiveDefinition { @@ -226,6 +233,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + intersection :: Packaging.PrimitiveDefinition intersection = Packaging.PrimitiveDefinition { @@ -260,46 +268,42 @@ Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s1"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s2"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldl")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), + 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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "el"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.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.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.insert")), + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.member")), 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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Set intersection, defined in terms of member and insert.")))]))})))} + 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"))}))}))}))})))} + map :: Packaging.PrimitiveDefinition map = Packaging.PrimitiveDefinition { @@ -340,26 +344,22 @@ Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "y")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "f"), + 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.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.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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Map a function over a set, defined in terms of toList, lists.map and fromList.")))]))})))} + Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.sets.toList")), + Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))}))}))}))})))} + member :: Packaging.PrimitiveDefinition member = Packaging.PrimitiveDefinition { @@ -395,6 +395,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + null :: Packaging.PrimitiveDefinition null = Packaging.PrimitiveDefinition { @@ -425,6 +426,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + singleton :: Packaging.PrimitiveDefinition singleton = Packaging.PrimitiveDefinition { @@ -455,6 +457,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + size :: Packaging.PrimitiveDefinition size = Packaging.PrimitiveDefinition { @@ -485,6 +488,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toList :: Packaging.PrimitiveDefinition toList = Packaging.PrimitiveDefinition { @@ -515,6 +519,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + union :: Packaging.PrimitiveDefinition union = Packaging.PrimitiveDefinition { @@ -549,36 +554,32 @@ Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s1"), + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "s2"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Core.lambdaBody = (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.lib.lists.foldl")), - Core.applicationArgument = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "acc"), + 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.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.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Set union, defined in terms of insert and toList.")))]))})))} + 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"))}))}))}))})))} + unions :: Packaging.PrimitiveDefinition unions = Packaging.PrimitiveDefinition { @@ -608,28 +609,23 @@ Typing.resultType = (Core.TypeSet (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, - Packaging.primitiveDefinitionDefaultImplementation = (Just (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermBody = (Core.TermLambda (Core.Lambda { - Core.lambdaParameter = (Core.Name "ss"), - Core.lambdaDomain = Nothing, - Core.lambdaBody = (Core.TermApplication (Core.Application { + Packaging.primitiveDefinitionDefaultImplementation = (Just (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.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.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.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"))}))})), - Core.annotatedTermAnnotation = (Core.TermMap (M.fromList [ - ( - Core.TermVariable (Core.Name "description"), - (Core.TermLiteral (Core.LiteralString "Union of a list of sets, defined in terms of foldl and union.")))]))})))} + 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/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 @@ -1,14 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Primitives in the hydra.lib.strings module. module Hydra.Lib.Strings 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 @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + cat :: Packaging.PrimitiveDefinition cat = Packaging.PrimitiveDefinition { @@ -51,6 +60,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + cat2 :: Packaging.PrimitiveDefinition cat2 = Packaging.PrimitiveDefinition { @@ -81,6 +91,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + fromList :: Packaging.PrimitiveDefinition fromList = Packaging.PrimitiveDefinition { @@ -107,6 +118,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + intercalate :: Packaging.PrimitiveDefinition intercalate = Packaging.PrimitiveDefinition { @@ -137,6 +149,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + length :: Packaging.PrimitiveDefinition length = Packaging.PrimitiveDefinition { @@ -163,6 +176,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + lines :: Packaging.PrimitiveDefinition lines = Packaging.PrimitiveDefinition { @@ -189,6 +203,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + maybeCharAt :: Packaging.PrimitiveDefinition maybeCharAt = Packaging.PrimitiveDefinition { @@ -219,6 +234,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + null :: Packaging.PrimitiveDefinition null = Packaging.PrimitiveDefinition { @@ -244,6 +260,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + splitOn :: Packaging.PrimitiveDefinition splitOn = Packaging.PrimitiveDefinition { @@ -275,6 +292,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toList :: Packaging.PrimitiveDefinition toList = Packaging.PrimitiveDefinition { @@ -300,6 +318,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toLower :: Packaging.PrimitiveDefinition toLower = Packaging.PrimitiveDefinition { @@ -327,6 +346,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + toUpper :: Packaging.PrimitiveDefinition toUpper = Packaging.PrimitiveDefinition { @@ -354,6 +374,7 @@ Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} + unlines :: Packaging.PrimitiveDefinition unlines = Packaging.PrimitiveDefinition { diff --git a/src/main/haskell/Hydra/Lib/System.hs b/src/main/haskell/Hydra/Lib/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/System.hs @@ -0,0 +1,177 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.system module. + +module Hydra.Lib.System 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 + +execute :: Packaging.PrimitiveDefinition +execute = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.execute"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Run a program to completion and capture its result."), + Packaging.entityMetadataComments = [ + "execute(command) describes an effectful computation which runs the program described by command to completion and returns its result. This is the POSIX \"execute a command\" operation at the posix_spawn / system() altitude (https://pubs.opengroup.org/onlinepubs/9799919799/functions/posix_spawn.html, https://pubs.opengroup.org/onlinepubs/9799919799/functions/system.html): the child is spawned, Hydra waits for it (POSIX waitpid), and standard output and standard error are captured as raw bytes. Output is byte-oriented, with no character decoding or newline translation; decode it to text via hydra.lib.text.decodeUtf8. A child that runs and exits with a non-zero status (POSIX WEXITSTATUS) is returned as right(result) with that StatusCode, following the XCU section 2.8.2 exit-status convention. Only a failure to launch -- for example POSIX ENOENT, EACCES, or a bad working directory -- is returned as left(error). Unlike the shell system(), no intermediate shell is invoked; command.program is executed directly (as the execvp family does), so shell syntax in arguments is not interpreted."], + 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.TypeVariable (Core.Name "hydra.system.Command")), + 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.TypeVariable (Core.Name "hydra.system.ProcessResult"))})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +exit :: Packaging.PrimitiveDefinition +exit = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.exit"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Terminate the current process with a status code."), + Packaging.entityMetadataComments = [ + "exit(code) describes an effectful computation which terminates the current process immediately with the given status, exactly as the POSIX exit() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/exit.html). The status is reported to the parent through wait(); by the XCU section 2.8.2 convention, 0 denotes success and non-zero denotes failure. This computation does not return, so subsequent effects in a sequence are not performed."], + 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.TypeVariable (Core.Name "hydra.system.StatusCode")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect Core.TypeUnit)}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +getEnvironment :: Packaging.PrimitiveDefinition +getEnvironment = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.getEnvironment"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Get the full set of environment variables."), + Packaging.entityMetadataComments = [ + "getEnvironment describes an effectful computation which returns the entire environment of the current process -- the POSIX environment list environ (XBD section 8, Environment Variables, https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html) -- as a map from variable name to value. POSIX represents each entry as a \"name=value\" string; this primitive splits each at the first '=' into an EnvironmentVariable key and a string value. This computation does not fail; an empty environment yields an empty map."], + 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.TypeMap (Core.MapType { + Core.mapTypeKeys = (Core.TypeVariable (Core.Name "hydra.system.EnvironmentVariable")), + Core.mapTypeValues = (Core.TypeLiteral Core.LiteralTypeString)})))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +getEnvironmentVariable :: Packaging.PrimitiveDefinition +getEnvironmentVariable = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.getEnvironmentVariable"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Look up a single environment variable by name."), + Packaging.entityMetadataComments = [ + "getEnvironmentVariable(name) describes an effectful computation which returns the value of the environment variable name, or none if it is not present -- the POSIX getenv() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/getenv.html). A variable that is present but set to the empty string is returned as given(\"\"), distinct from the none that POSIX getenv signals with a null pointer. This computation does not fail."], + 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.TypeVariable (Core.Name "hydra.system.EnvironmentVariable")), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEffect (Core.TypeOptional (Core.TypeLiteral Core.LiteralTypeString)))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +getTime :: Packaging.PrimitiveDefinition +getTime = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.getTime"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Get the current wall-clock time."), + Packaging.entityMetadataComments = [ + "getTime describes an effectful computation which returns the current wall-clock time as a Timespec (seconds and nanoseconds since the Unix Epoch) -- the POSIX clock_gettime() function with the CLOCK_REALTIME clock (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/clock_gettime.html). The actual resolution is implementation- and platform-defined and may be coarser than nanoseconds. As with CLOCK_REALTIME, the clock is not monotonic: it can jump or move backwards when the host's wall clock is adjusted. This computation does not fail."], + 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.TypeVariable (Core.Name "hydra.time.Timespec")))}}, + Packaging.primitiveDefinitionIsPure = False, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +getWorkingDirectory :: Packaging.PrimitiveDefinition +getWorkingDirectory = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.system.getWorkingDirectory"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Get the current working directory."), + Packaging.entityMetadataComments = [ + "getWorkingDirectory describes an effectful computation which returns the absolute pathname of the current working directory -- the POSIX getcwd() function (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/getcwd.html) -- as a FilePath. A recoverable failure (for example POSIX EACCES, or the working directory having been removed) is returned as left(error); success is returned as right(path)."], + 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.TypeVariable (Core.Name "hydra.file.FilePath"))})))}}, + 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 new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Lib/Text.hs @@ -0,0 +1,90 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | Primitives in the hydra.lib.text module. + +module Hydra.Lib.Text 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 + +decodeUtf8 :: Packaging.PrimitiveDefinition +decodeUtf8 = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.text.decodeUtf8"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Decode a sequence of bytes as UTF-8 text."), + Packaging.entityMetadataComments = [ + "decodeUtf8(bytes) attempts to interpret bytes as a UTF-8 encoded string. A byte sequence which is not valid UTF-8 yields left(message), where message is a host-provided description of the decoding failure; a successful decode yields right(text).", + "Pairs with hydra.lib.files.readFile, which returns raw bytes."], + 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.LiteralTypeBinary), + Typing.parameterIsLazy = False}], + Typing.termSignatureResult = Typing.Result { + Typing.resultDescription = Nothing, + Typing.resultType = (Core.TypeEither (Core.EitherType { + Core.eitherTypeLeft = (Core.TypeLiteral Core.LiteralTypeString), + Core.eitherTypeRight = (Core.TypeLiteral Core.LiteralTypeString)}))}}, + Packaging.primitiveDefinitionIsPure = True, + Packaging.primitiveDefinitionIsTotal = True, + Packaging.primitiveDefinitionDefaultImplementation = Nothing} + +encodeUtf8 :: Packaging.PrimitiveDefinition +encodeUtf8 = + Packaging.PrimitiveDefinition { + Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.text.encodeUtf8"), + Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata { + Packaging.entityMetadataDescription = (Just "Encode text as a sequence of UTF-8 bytes."), + Packaging.entityMetadataComments = [ + "encodeUtf8(text) returns the UTF-8 encoding of text as raw bytes. Total: every Hydra string is valid Unicode and therefore always encodes.", + "Pairs with hydra.lib.files.writeFile, which expects raw bytes."], + 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} 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 @@ -1,24 +1,32 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Conversion functions for literal values. module Hydra.Literals 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.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals 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 @@ -27,6 +35,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Convert a bigint to an integer value of a given type (note: lossy) bigintToIntegerValue :: Core.IntegerType -> Integer -> Core.IntegerValue bigintToIntegerValue it bi = @@ -40,6 +49,7 @@ Core.IntegerTypeUint16 -> Core.IntegerValueUint16 (Literals.bigintToUint16 bi) Core.IntegerTypeUint32 -> Core.IntegerValueUint32 (Literals.bigintToUint32 bi) Core.IntegerTypeUint64 -> Core.IntegerValueUint64 (Literals.bigintToUint64 bi) + -- | Convert an integer value of any precision to a bigint integerValueToBigint :: Core.IntegerValue -> Integer integerValueToBigint x = 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 @@ -1,35 +1,44 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for working with qualified names. module Hydra.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.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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.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 @@ -40,6 +49,17 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + +-- | Pick a string label that does not collide with a reserved set, by appending a numeric suffix when necessary +chooseUniqueLabel :: S.Set String -> String -> String +chooseUniqueLabel reserved label = + + let tryLabel = + \index -> + let candidate = Logic.ifElse (Equality.equal index 1) label (Strings.cat2 label (Literals.showInt32 index)) + in (Logic.ifElse (Sets.member candidate reserved) (tryLabel (Math.add index 1)) candidate) + in (tryLabel 1) + -- | Given a mapping of namespaces to prefixes, convert a name to a compact string representation compactName :: M.Map Packaging.ModuleName String -> Core.Name -> String compactName namespaces name = @@ -51,6 +71,7 @@ pre, ":", local]))) + -- | Generate a fresh type variable name, threading InferenceContext freshName :: Typing.InferenceContext -> (Core.Name, Typing.InferenceContext) freshName cx = @@ -61,6 +82,7 @@ Typing.InferenceContext { Typing.inferenceContextFreshTypeVariableCount = (Math.add count 1), Typing.inferenceContextTrace = (Typing.inferenceContextTrace cx)}) + -- | Generate multiple fresh type variable names, threading InferenceContext freshNames :: Int -> Typing.InferenceContext -> ([Core.Name], Typing.InferenceContext) freshNames n cx = @@ -74,20 +96,24 @@ cx1 = Pairs.second result in (Lists.concat2 names (Lists.pure name), cx1) in (Lists.foldl go ([], cx) (Lists.replicate n ())) + -- | Extract the local part of a name localNameOf :: Core.Name -> String localNameOf arg_ = Util.qualifiedNameLocal (qualifyName arg_) + -- | Extract the module name of a name, if any moduleNameOf :: Core.Name -> Maybe Packaging.ModuleName moduleNameOf arg_ = Util.qualifiedNameModuleName (qualifyName arg_) + -- | Convert a module name to a file path with the given case convention and file extension -moduleNameToFilePath :: Util.CaseConvention -> Util.FileExtension -> Packaging.ModuleName -> String +moduleNameToFilePath :: Util.CaseConvention -> File.FileExtension -> Packaging.ModuleName -> String 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) ".") (Util.unFileExtension ext)) + in (Strings.cat2 (Strings.cat2 (Strings.intercalate "/" 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 -> Util.FileExtension -> Core.Name -> String +nameToFilePath :: Util.CaseConvention -> Util.CaseConvention -> File.FileExtension -> Core.Name -> String nameToFilePath nsConv localConv ext name = let qualName = qualifyName name @@ -101,16 +127,19 @@ prefix, suffix, ".", - (Util.unFileExtension ext)]) + (File.unFileExtension ext)]) + -- | Type variable naming convention follows Haskell: t0, t1, etc. normalTypeVariable :: Int -> Core.Name normalTypeVariable i = Core.Name (Strings.cat2 "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 pushSubtermStep step cx = Typing.InferenceContext { Typing.inferenceContextFreshTypeVariableCount = (Typing.inferenceContextFreshTypeVariableCount cx), Typing.inferenceContextTrace = (Lists.cons step (Typing.inferenceContextTrace cx))} + -- | Construct a qualified (dot-separated) name qname :: Packaging.ModuleName -> String -> Core.Name qname ns name = @@ -118,6 +147,7 @@ Packaging.unModuleName ns, ".", name]) + -- | Split a dot-separated name into a namespace and local name qualifyName :: Core.Name -> Util.QualifiedName qualifyName name = @@ -133,15 +163,14 @@ Util.qualifiedNameLocal = (Core.unName name)}) (Util.QualifiedName { Util.qualifiedNameModuleName = (Just (Packaging.ModuleName (Strings.intercalate "." (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. restoreTrace :: Typing.InferenceContext -> Typing.InferenceContext -> Typing.InferenceContext restoreTrace baseCx newCx = Typing.InferenceContext { Typing.inferenceContextFreshTypeVariableCount = (Typing.inferenceContextFreshTypeVariableCount newCx), Typing.inferenceContextTrace = (Typing.inferenceContextTrace baseCx)} --- | Generate a unique label by appending a suffix if the label is already in use -uniqueLabel :: S.Set String -> String -> String -uniqueLabel visited l = Logic.ifElse (Sets.member l visited) (uniqueLabel visited (Strings.cat2 l "'")) l + -- | Convert a qualified name to a dot-separated name unqualifyName :: Util.QualifiedName -> Core.Name unqualifyName qname = diff --git a/src/main/haskell/Hydra/Overlay/Haskell/AsTerm.hs b/src/main/haskell/Hydra/Overlay/Haskell/AsTerm.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/AsTerm.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} + +-- | Type class for implicit coercion to TypedTerm +-- This allows TypedTerm, TypedBinding, and String to be used where a TypedTerm is expected, +-- while preserving phantom type information. + +module Hydra.Overlay.Haskell.AsTerm where + +import Hydra.Core +import Hydra.Packaging +import Hydra.Typed + + +-- | Type class for implicit coercion to TypedTerm, preserving phantom types +-- TypedTerm passes through unchanged, TypedBinding becomes a variable reference +-- The functional dependency ensures that the input type determines the phantom type +class AsTerm f a | f -> a where + asTerm :: f -> TypedTerm a + +instance AsTerm (TypedTerm a) a where + asTerm = id + +instance AsTerm (TypedBinding a) a where + asTerm (TypedBinding name _) = TypedTerm (TermVariable name) + +instance AsTerm (TypedTermDefinition a) a where + asTerm (TypedTermDefinition name _) = TypedTerm (TermVariable name) + +instance AsTerm String String where + asTerm s = TypedTerm $ TermLiteral $ LiteralString s + +instance AsTerm Int Int where + asTerm i = TypedTerm $ TermLiteral $ LiteralInteger $ IntegerValueInt32 i + + +-- | Type class for types from which a kernel-level 'Name' can be statically extracted. +-- Used by Phantoms primitives like 'inject', 'match', 'project', 'record', 'unwrap', 'wrap' +-- to accept either a bare 'Name' or any name-typed binding/definition where the 'Name' +-- is known at construction time. Distinct from 'AsTerm' (which can lift arbitrary +-- @TypedTerm Name@ values, but those don't yield a static 'Name'). +class AsName n where + asName :: n -> Name + +instance AsName Name where + asName = id + +instance AsName (TypedBinding Name) where + asName (TypedBinding name _) = name + +instance AsName (TypedTermDefinition Name) where + asName (TypedTermDefinition name _) = name diff --git a/src/main/haskell/Hydra/Overlay/Haskell/AsType.hs b/src/main/haskell/Hydra/Overlay/Haskell/AsType.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/AsType.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- | Type class for implicit coercion to Type +-- This allows Type, TypeDefinition, and String to be used where a Type is expected + +module Hydra.Overlay.Haskell.AsType where + +import Hydra.Core +import Hydra.Packaging + + +-- | Type class for implicit coercion to Type +-- This allows Type, TypeDefinition, and String to be used where a Type is expected +class AsType a where + asType :: a -> Type + +instance AsType Type where + asType = id + +-- | A TypeDefinition is referenced as a type variable bearing its name. +instance AsType TypeDefinition where + asType = TypeVariable . typeDefinitionName + +instance AsType String where + asType s = TypeVariable (Name s) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Bootstrap.hs b/src/main/haskell/Hydra/Overlay/Haskell/Bootstrap.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Bootstrap.hs @@ -0,0 +1,76 @@ +-- | A bootstrapping DSL, used for Hydra's inner core models + +module Hydra.Overlay.Haskell.Bootstrap ( + module Hydra.Overlay.Haskell.AsType, + bootstrapGraph, + datatype, + descriptionMetadata, + qualify, + qualifiedDep, + typeref, + defineType, + unqualifiedDep, +) where + +import Hydra.Util +import Hydra.Constants +import Hydra.Core +import Hydra.Overlay.Haskell.AsType +import Hydra.Graph +import Hydra.Lexical +import Hydra.Annotations +import Hydra.Packaging +import Hydra.Overlay.Haskell.Libraries + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S + + +-- | An empty graph (no elements, no schema, but with primitive functions) which is used for bootstrapping Hydra Core +bootstrapGraph :: Graph +bootstrapGraph = Graph { + graphBoundTerms = M.empty, + graphBoundTypes = M.empty, + graphClassConstraints = M.empty, + graphLambdaVariables = S.empty, + graphMetadata = M.empty, + graphPrimitives = M.fromList $ fmap (\p -> (primitiveDefinitionName (primitiveDefinition p), p)) (L.concat (libraryPrimitives <$> standardLibraries)), + graphSchemaTypes = M.empty, + graphTypeVariables = S.empty} + +-- | Define a type in a namespace, producing a TypeDefinition directly. +datatype :: ModuleName -> String -> Type -> TypeDefinition +datatype gname lname typ = TypeDefinition { + typeDefinitionName = qualify gname (Name lname), + typeDefinitionMetadata = Nothing, + typeDefinitionBody = TypeScheme { + typeSchemeVariables = [], + typeSchemeBody = typ, + typeSchemeConstraints = Nothing}} + +-- | Define a type in a namespace +defineType :: ModuleName -> String -> Type -> TypeDefinition +defineType = datatype + +-- | A module dependency qualified by the providing package, for disambiguation. +-- Not yet used, but retained for forthcoming package-qualified dependency resolution. +qualifiedDep :: PackageName -> ModuleName -> ModuleDependency +qualifiedDep pkg ns = ModuleDependency ns (Just pkg) + +qualify :: ModuleName -> Name -> Name +qualify (ModuleName gname) (Name lname) = Name $ gname ++ "." ++ lname + +typeref :: ModuleName -> String -> Type +typeref ns = TypeVariable . qualify ns . Name + +-- | An unqualified module dependency (package omitted; resolver searches all packages in scope) +unqualifiedDep :: ModuleName -> ModuleDependency +unqualifiedDep ns = ModuleDependency ns Nothing + +-- | Wrap an optional description string as entity metadata carrying only that description. +-- Used to migrate the former Module/Package `description` field into the `metadata` field +-- without data loss; a Nothing description yields no metadata. +descriptionMetadata :: Maybe String -> Maybe EntityMetadata +descriptionMetadata Nothing = Nothing +descriptionMetadata desc = Just (EntityMetadata desc [] [] Nothing) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Annotations.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Annotations.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Annotations.hs @@ -0,0 +1,85 @@ +-- | A DSL which is used as a basis for some of the other DSLs + +module Hydra.Overlay.Haskell.Dsl.Annotations where + +import Hydra.Core +import Hydra.Util +import Hydra.Constants +import Hydra.Annotations +import Hydra.Overlay.Haskell.AsType +import Hydra.Formatting +import Hydra.Overlay.Haskell.Dsl.Terms as Terms +import qualified Hydra.Overlay.Haskell.Dsl.Types as Types + +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +annotateTerm :: Name -> Y.Maybe Term -> Term -> Term +annotateTerm = setTermAnnotation + +annotateType :: Name -> Y.Maybe Term -> Type -> Type +annotateType = setTypeAnnotation + +bounded :: Maybe Int -> Maybe Int -> Type -> Type +bounded min max = annotMin . annotMax + where + annotMax t = Y.maybe t (`setMaxLength` t) max + annotMin t = Y.maybe t (`setMinLength` t) min + +boundedList :: AsType a => Maybe Int -> Maybe Int -> a -> Type +boundedList min max et = bounded min max $ Types.list (asType et) + +boundedMap :: (AsType a, AsType b) => Maybe Int -> Maybe Int -> a -> b -> Type +boundedMap min max kt vt = bounded min max $ Types.map (asType kt) (asType vt) + +boundedSet :: AsType a => Maybe Int -> Maybe Int -> a -> Type +boundedSet min max et = bounded min max $ Types.set (asType et) + +boundedString :: Maybe Int -> Maybe Int -> Type +boundedString min max = bounded min max Types.string + +dataDoc :: String -> Term -> Term +dataDoc s = setTermDescription (Just s) + +deprecated :: AsType a => a -> Type +deprecated = setTypeAnnotation keyDeprecated (Just $ Terms.boolean True) . asType + +doc :: AsType a => String -> a -> Type +doc s = setTypeDescription (Just s) . asType + +doc70 :: AsType a => String -> a -> Type +doc70 = doc . wrapLine 70 + +doc80 :: AsType a => String -> a -> Type +doc80 = doc . wrapLine 80 + +exclude :: AsType a => a -> Type +exclude = setTypeAnnotation keyExclude (Just $ Terms.boolean True) . asType + +minLengthList :: AsType a => Int -> a -> Type +minLengthList len = boundedList (Just len) Nothing + +nonemptyList :: AsType a => a -> Type +nonemptyList = minLengthList 1 + +nonemptyMap :: (AsType a, AsType b) => a -> b -> Type +nonemptyMap = boundedMap (Just 1) Nothing + +note :: AsType a => String -> a -> Type +note s = doc $ "Note: " ++ s + +preserveFieldName :: AsType a => a -> Type +preserveFieldName = setTypeAnnotation keyPreserveFieldName (Just $ Terms.boolean True) . asType + +see :: AsType a => String -> a -> Type +see s = doc $ "See " ++ s + +setMaxLength :: Int -> Type -> Type +setMaxLength m = setTypeAnnotation keyMaxLength (Just $ Terms.int32 m) + +setMinLength :: Int -> Type -> Type +setMinLength m = setTypeAnnotation keyMinLength (Just $ Terms.int32 m) + +twoOrMoreList :: AsType a => a -> Type +twoOrMoreList = boundedList (Just 2) Nothing diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Deep/Lib/Math.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Deep/Lib/Math.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Deep/Lib/Math.hs @@ -0,0 +1,131 @@ +-- | Deep term DSL for the hydra.lib.math library. +-- +-- These helpers construct Term-valued representations of math primitive +-- applications (TypedTerm Term), as opposed to the shallow DSL in +-- Hydra.Overlay.Haskell.Lib.Math which works at the Haskell value level (TypedTerm Double, etc.). + +module Hydra.Overlay.Haskell.Dsl.Deep.Lib.Math where + +import Hydra.Kernel +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Core as Core +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms (encodedName) +import Hydra.Overlay.Haskell.Dsl.Terms (ToPrimName(..)) +import qualified Hydra.Overlay.Haskell.Dsl.Prims as Prims +import qualified Hydra.Lib.Math as DefMath + + +-- | Apply a unary math primitive to a deep term +apply1 :: ToPrimName n => n -> TypedTerm Term -> TypedTerm Term +apply1 n arg = Core.termApplication $ Core.application (Core.termVariable $ encodedName $ toPrimName n) arg + +-- | Apply a binary math primitive to two deep terms +apply2 :: ToPrimName n => n -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term +apply2 n a b = Core.termApplication $ Core.application + (Core.termApplication $ Core.application (Core.termVariable $ encodedName $ toPrimName n) a) + b + +-- | Reference a math primitive as a deep term (for use as a first-class value) +ref :: ToPrimName n => n -> TypedTerm Term +ref = Core.termVariable . encodedName . toPrimName + + +-- Unary functions + +abs :: TypedTerm Term -> TypedTerm Term +abs = apply1 (Prims.primName DefMath.abs) + +acos :: TypedTerm Term -> TypedTerm Term +acos = apply1 (Prims.primName DefMath.acos) + +acosh :: TypedTerm Term -> TypedTerm Term +acosh = apply1 (Prims.primName DefMath.acosh) + +asin :: TypedTerm Term -> TypedTerm Term +asin = apply1 (Prims.primName DefMath.asin) + +asinh :: TypedTerm Term -> TypedTerm Term +asinh = apply1 (Prims.primName DefMath.asinh) + +atan :: TypedTerm Term -> TypedTerm Term +atan = apply1 (Prims.primName DefMath.atan) + +atanh :: TypedTerm Term -> TypedTerm Term +atanh = apply1 (Prims.primName DefMath.atanh) + +ceiling :: TypedTerm Term -> TypedTerm Term +ceiling = apply1 (Prims.primName DefMath.ceiling) + +cos :: TypedTerm Term -> TypedTerm Term +cos = apply1 (Prims.primName DefMath.cos) + +cosh :: TypedTerm Term -> TypedTerm Term +cosh = apply1 (Prims.primName DefMath.cosh) + +exp :: TypedTerm Term -> TypedTerm Term +exp = apply1 (Prims.primName DefMath.exp) + +floor :: TypedTerm Term -> TypedTerm Term +floor = apply1 (Prims.primName DefMath.floor) + +log :: TypedTerm Term -> TypedTerm Term +log = apply1 (Prims.primName DefMath.log) + +negate :: TypedTerm Term -> TypedTerm Term +negate = apply1 (Prims.primName DefMath.negate) + +negateFloat64 :: TypedTerm Term -> TypedTerm Term +negateFloat64 = apply1 (Prims.primName DefMath.negateFloat64) + +round :: TypedTerm Term -> TypedTerm Term +round = apply1 (Prims.primName DefMath.round) + +signum :: TypedTerm Term -> TypedTerm Term +signum = apply1 (Prims.primName DefMath.signum) + +sin :: TypedTerm Term -> TypedTerm Term +sin = apply1 (Prims.primName DefMath.sin) + +sinh :: TypedTerm Term -> TypedTerm Term +sinh = apply1 (Prims.primName DefMath.sinh) + +sqrt :: TypedTerm Term -> TypedTerm Term +sqrt = apply1 (Prims.primName DefMath.sqrt) + +tan :: TypedTerm Term -> TypedTerm Term +tan = apply1 (Prims.primName DefMath.tan) + +tanh :: TypedTerm Term -> TypedTerm Term +tanh = apply1 (Prims.primName DefMath.tanh) + +truncate :: TypedTerm Term -> TypedTerm Term +truncate = apply1 (Prims.primName DefMath.truncate) + + +-- Binary functions + +add :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +add = apply2 (Prims.primName DefMath.add) + +addFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +addFloat64 = apply2 (Prims.primName DefMath.addFloat64) + +atan2 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +atan2 = apply2 (Prims.primName DefMath.atan2) + +logBase :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +logBase = apply2 (Prims.primName DefMath.logBase) + +mul :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +mul = apply2 (Prims.primName DefMath.mul) + +mulFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +mulFloat64 = apply2 (Prims.primName DefMath.mulFloat64) + +pow :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +pow = apply2 (Prims.primName DefMath.pow) + +sub :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +sub = apply2 (Prims.primName DefMath.sub) + +subFloat64 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +subFloat64 = apply2 (Prims.primName DefMath.subFloat64) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/LiteralTypes.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/LiteralTypes.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/LiteralTypes.hs @@ -0,0 +1,86 @@ +-- | A DSL for Hydra literal types in Haskell + +module Hydra.Overlay.Haskell.Dsl.LiteralTypes where + +import Hydra.Core + + +-- | Arbitrary-precision integer type +-- Example: bigint +bigint :: LiteralType +bigint = LiteralTypeInteger IntegerTypeBigint + +-- | Binary data type +-- Example: binary +binary :: LiteralType +binary = LiteralTypeBinary + +-- | Boolean type +-- Example: boolean +boolean :: LiteralType +boolean = LiteralTypeBoolean + +-- | Create a floating point type with the specified precision +-- Example: float FloatTypeFloat32 +float :: FloatType -> LiteralType +float = LiteralTypeFloat + +-- | 32-bit floating point type +-- Example: float32 +float32 :: LiteralType +float32 = float FloatTypeFloat32 + +-- | 64-bit floating point type +-- Example: float64 +float64 :: LiteralType +float64 = float FloatTypeFloat64 + +-- | 16-bit signed integer type +-- Example: int16 +int16 :: LiteralType +int16 = integer IntegerTypeInt16 + +-- | 32-bit signed integer type +-- Example: int32 +int32 :: LiteralType +int32 = integer IntegerTypeInt32 + +-- | 64-bit signed integer type +-- Example: int64 +int64 :: LiteralType +int64 = integer IntegerTypeInt64 + +-- | 8-bit signed integer type +-- Example: int8 +int8 :: LiteralType +int8 = integer IntegerTypeInt8 + +-- | Create an integer type with the specified bit width +-- Example: integer IntegerTypeInt32 +integer :: IntegerType -> LiteralType +integer = LiteralTypeInteger + +-- | String type +-- Example: string +string :: LiteralType +string = LiteralTypeString + +-- | 16-bit unsigned integer type +-- Example: uint16 +uint16 :: LiteralType +uint16 = integer IntegerTypeUint16 + +-- | 32-bit unsigned integer type +-- Example: uint32 +uint32 :: LiteralType +uint32 = integer IntegerTypeUint32 + +-- | 64-bit unsigned integer type +-- Example: uint64 +uint64 :: LiteralType +uint64 = integer IntegerTypeUint64 + +-- | 8-bit unsigned integer type +-- Example: uint8 +uint8 :: LiteralType +uint8 = integer IntegerTypeUint8 diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Literals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Literals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Literals.hs @@ -0,0 +1,95 @@ +-- | A DSL for constructing Hydra literal values in Haskell + +module Hydra.Overlay.Haskell.Dsl.Literals where + +import Hydra.Core + +import Data.Int +import qualified Data.ByteString as B +import qualified Data.Scientific as Sci + + +-- | Create an arbitrary-precision integer literal +-- Example: bigint 9223372036854775808 +bigint :: Integer -> Literal +bigint = integer . IntegerValueBigint . fromIntegral + +-- | Create a binary data literal +-- Example: binary (B.pack [0x48, 0x65, 0x6C, 0x6C, 0x6F]) +binary :: B.ByteString -> Literal +binary = LiteralBinary + +-- | Create a boolean literal +-- Example: boolean True +boolean :: Bool -> Literal +boolean = LiteralBoolean + +-- | Create an arbitrary-precision decimal literal +-- Example: decimal (Sci.scientific 314159265359 (-11)) +decimal :: Sci.Scientific -> Literal +decimal = LiteralDecimal + +-- | Create a floating-point literal with specified precision +-- Example: float (FloatValueFloat32 3.14) +float :: FloatValue -> Literal +float = LiteralFloat + +-- | Create a 32-bit floating point literal +-- Example: float32 3.14 +float32 :: Float -> Literal +float32 = float . FloatValueFloat32 + +-- | Create a 64-bit floating point literal +-- Example: float64 3.14159265359 +float64 :: Double -> Literal +float64 = float . FloatValueFloat64 + +-- | Create a 16-bit signed integer literal +-- Example: int16 32767 +int16 :: Int16 -> Literal +int16 = integer . IntegerValueInt16 . fromIntegral + +-- | Create a 32-bit signed integer literal +-- Example: int32 42 +int32 :: Int -> Literal +int32 = integer . IntegerValueInt32 + +-- | Create a 64-bit signed integer literal +-- Example: int64 9223372036854775807 +int64 :: Int64 -> Literal +int64 = integer . IntegerValueInt64 . fromIntegral + +-- | Create an 8-bit signed integer literal +-- Example: int8 127 +int8 :: Int8 -> Literal +int8 = integer . IntegerValueInt8 . fromIntegral + +-- | Create an integer literal with specified bit width +-- Example: integer (IntegerValueInt32 42) +integer :: IntegerValue -> Literal +integer = LiteralInteger + +-- | Create a string literal +-- Example: string "hello world" +string :: String -> Literal +string = LiteralString + +-- | Create a 16-bit unsigned integer literal +-- Example: uint16 65535 +uint16 :: Int -> Literal +uint16 = integer . IntegerValueUint16 . fromIntegral + +-- | Create a 32-bit unsigned integer literal +-- Example: uint32 4294967295 +uint32 :: Int64 -> Literal +uint32 = integer . IntegerValueUint32 . fromIntegral + +-- | Create a 64-bit unsigned integer literal +-- Example: uint64 18446744073709551615 +uint64 :: Integer -> Literal +uint64 = integer . IntegerValueUint64 . fromIntegral + +-- | Create an 8-bit unsigned integer literal +-- Example: uint8 255 +uint8 :: Int16 -> Literal +uint8 = integer . IntegerValueUint8 . fromIntegral diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Prims.hs @@ -0,0 +1,440 @@ +{-# LANGUAGE FlexibleInstances #-} -- for IsString with nontrivial parameters + +-- | A DSL for constructing primitive function definitions +module Hydra.Overlay.Haskell.Dsl.Prims where + +import Hydra.Core +import Hydra.Graph +import Hydra.Packaging +import Hydra.Scoping (typeSchemeToTermSignature) +import Hydra.Util +import qualified Hydra.Encode.Core as EncodeCore +import qualified Hydra.Decode.Core as DecodeCore +import qualified Hydra.Extract.Core as ExtractCore +import qualified Hydra.Typing as Typing +import qualified Hydra.Errors as Error +import qualified Hydra.Extract.Util as ExtractUtil +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 Data.Int +import qualified Data.ByteString as B +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Scientific as Sci +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Strip (removeTermAnnotations) +import Hydra.Lexical (emptyInferenceContext) +import Data.String(IsString(..)) +import Data.Either (Either) + +-- | Placeholder InferenceContext for the TermCoder encode/decode machinery used inside the prim* +-- wrappers. Since #446, a Primitive's implementation carrier no longer threads the InferenceContext: +-- coders use it only for error context (otherErr ignores it) and decode (which doesn't consult it), +-- so an empty cx is sufficient and correct. The Graph, by contrast, is still threaded through the +-- carrier and passed to the coders, because the higher-order primitives that evaluate a function +-- argument (via functionWithReduce) need the live graph to resolve primitive names. +primCx :: Typing.InferenceContext +primCx = emptyInferenceContext + +bigint :: TermCoder Integer +bigint = TermCoder Types.bigint encode decode + where + encode _cx g = ExtractCore.bigint g + decode _cx = Right . Terms.bigint + +binary :: TermCoder B.ByteString +binary = TermCoder Types.binary encode decode + where + encode _cx g = ExtractCore.binary g + decode _cx = Right . Terms.binary + +boolean :: TermCoder Bool +boolean = TermCoder Types.boolean encode decode + where + 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 +comparison = TermCoder (TypeVariable _Comparison) encode decode + where + encode _cx g = ExtractUtil.comparison _cx g + decode _cx = Right . Terms.comparison + +decimal :: TermCoder Sci.Scientific +decimal = TermCoder Types.decimal encode decode + where + encode _cx g = ExtractCore.decimal g + decode _cx = Right . Terms.decimal + +-- | The qualified name of a primitive, read from its PrimitiveDefinition. A short +-- contextual alias for 'primitiveDefinitionName', used by DSL source modules to +-- reference primitive names via the generated Hydra.Lib.* definition modules (e.g. +-- @primName Math.acos@) instead of hand-maintained name constants. +primName :: PrimitiveDefinition -> Name +primName = primitiveDefinitionName + +-- 'ToPrimName' (used by prim0/prim1/prim2/prim3 below to accept a generated PrimitiveDefinition +-- 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 +sig = typeSchemeToTermSignature + +-- | Mark the value parameters at the given (0-based) positions of a primitive's +-- signature as lazy. Used at the prim*-based registration sites in +-- Hydra.Overlay.Haskell.Libraries to record which arguments coders must thunk in hosts +-- that distinguish strict from lazy evaluation (issue #391). The kernel DSL +-- sources (Hydra.Sources.Kernel.Lib.*) carry the same flags via lazySig; this +-- keeps the Haskell-host bootstrapGraph in agreement with the JSON. +lazyArgs :: [Int] -> Primitive -> Primitive +lazyArgs idxs p = p { primitiveDefinition = markLazyDef (primitiveDefinition p) } + where + markLazyDef d = d { + primitiveDefinitionSignature = markLazySig (primitiveDefinitionSignature d) } + markLazySig s = s { + Typing.termSignatureParameters = + zipWith markParam [0..] (Typing.termSignatureParameters s) } + markParam i param = + if i `elem` idxs then param { Typing.parameterIsLazy = True } else param + +either_ :: TermCoder x -> TermCoder y -> TermCoder (Prelude.Either x y) +either_ xCoder yCoder = TermCoder (Types.either_ (termCoderType xCoder) (termCoderType yCoder)) encode decode + where + encode cx g term = case term of + TermEither (Prelude.Left l) -> Prelude.Left <$> termCoderEncode xCoder cx g l + TermEither (Prelude.Right r) -> Prelude.Right <$> termCoderEncode yCoder cx g r + _ -> Left $ otherErr cx $ "expected either term, got: " ++ show term + decode cx ev = case ev of + Prelude.Left x -> do + xTerm <- termCoderDecode xCoder cx x + return $ Terms.left xTerm + Prelude.Right y -> do + yTerm <- termCoderDecode yCoder cx y + return $ Terms.right yTerm + +float32 :: TermCoder Float +float32 = TermCoder Types.float32 encode decode + where + encode _cx g = ExtractCore.float32 g + decode _cx = Right . Terms.float32 + +float64 :: TermCoder Double +float64 = TermCoder Types.float64 encode decode + where + encode _cx g = ExtractCore.float64 g + decode _cx = Right . Terms.float64 + +floatType :: TermCoder FloatType +floatType = TermCoder (TypeVariable _FloatType) encode decode + where + encode _cx g term = case DecodeCore.floatType g term of + Left err -> Left $ Error.ErrorDecoding err + Right v -> Right v + decode _cx = Right . EncodeCore.floatType + +floatValue :: TermCoder FloatValue +floatValue = TermCoder (TypeVariable _FloatValue) encode decode + where + encode _cx g = ExtractCore.floatValue g + decode _cx = Right . Terms.float + +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 + 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 +-- evaluate the application eagerly, the bridged native function builds an UNREDUCED application +-- term @apply funTerm argTerm@ and lets the interpreter's outer @reduce@ fold it. This is the +-- replacement for @functionWithReduce@ for the higher-order primitives whose result shape is +-- fixed by the (already-reduced) data argument's spine — i.e. those that never need to inspect +-- the reduced value of a per-element application mid-computation. It threads no InferenceContext +-- or Graph, which is what lets the @Primitive.implementation@ carrier drop those parameters. +-- +-- Only the encode side is defined (functions are never decoded back to terms), matching +-- @functionWithReduce@. dom/cod are the term coders for the argument and result; for the +-- higher-order primitives this is always the identity @term@/@variable@ coder, so a bridged +-- @Term -> Term@ is @\\argTerm -> TermApplication (Application funTerm argTerm)@. +functionDeferred :: TermCoder x -> TermCoder y -> TermCoder (x -> y) +functionDeferred dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) encode decode + where + encode cx g funTerm = Right $ \x -> + let argTerm = case termCoderDecode dom cx x of + Left _ -> error "functionDeferred: failed to decode argument" + Right t -> t + resultTerm = TermApplication (Application funTerm argTerm) + in case termCoderEncode cod cx g resultTerm of + Left _ -> error "functionDeferred: failed to encode result" + Right v -> v + decode cx _val = Left $ otherErr cx "cannot decode functions to terms" + +-- | A TermCoder for function types, using a reducer to bridge term-level functions to native functions. +-- The reducer is called to evaluate function application at the term level. +-- Failures in reduction or encoding/decoding will result in a runtime error. +functionWithReduce :: (Typing.InferenceContext -> Graph -> Term -> Either Error.Error Term) -> TermCoder x -> TermCoder y -> TermCoder (x -> y) +functionWithReduce reduce dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) encode decode + where + encode cx g funTerm = Right $ \x -> + let argTerm = case termCoderDecode dom cx x of + Left _ -> error "functionWithReduce: failed to encode argument" + Right t -> t + resultTerm = case reduce cx g (TermApplication (Application funTerm argTerm)) of + Left _ -> error "functionWithReduce: failed to reduce application" + Right t -> t + in case termCoderEncode cod cx g resultTerm of + Left _ -> error "functionWithReduce: failed to decode result" + Right v -> v + decode cx _val = Left $ otherErr cx "cannot decode functions to terms" + +int16 :: TermCoder Int16 +int16 = TermCoder Types.int16 encode decode + where + encode _cx g = ExtractCore.int16 g + decode _cx = Right . Terms.int16 + +int32 :: TermCoder Int +int32 = TermCoder Types.int32 encode decode + where + encode _cx g = ExtractCore.int32 g + decode _cx = Right . Terms.int32 + +int64 :: TermCoder Int64 +int64 = TermCoder Types.int64 encode decode + where + encode _cx g = ExtractCore.int64 g + decode _cx = Right . Terms.int64 + +int8 :: TermCoder Int8 +int8 = TermCoder Types.int8 encode decode + where + encode _cx g = ExtractCore.int8 g + decode _cx = Right . Terms.int8 + +integerType :: TermCoder IntegerType +integerType = TermCoder (TypeVariable _IntegerType) encode decode + where + encode _cx g term = case DecodeCore.integerType g term of + Left err -> Left $ Error.ErrorDecoding err + Right v -> Right v + decode _cx = Right . EncodeCore.integerType + +integerValue :: TermCoder IntegerValue +integerValue = TermCoder (TypeVariable _IntegerValue) encode decode + where + encode _cx g = ExtractCore.integerValue g + decode _cx = Right . Terms.integer + +list :: TermCoder x -> TermCoder [x] +list els = TermCoder (Types.list $ termCoderType els) encode decode + where + encode cx g = ExtractCore.listOf (termCoderEncode els cx g) g + decode cx l = Terms.list <$> mapM (termCoderDecode els cx) l + +literal :: TermCoder Literal +literal = TermCoder (TypeVariable _Literal) encode decode + where + encode _cx g = ExtractCore.literal g + decode _cx = Right . Terms.literal + +literalType :: TermCoder LiteralType +literalType = TermCoder (TypeVariable _LiteralType) encode decode + where + encode _cx g term = case DecodeCore.literalType g term of + Left err -> Left $ Error.ErrorDecoding err + Right v -> Right v + decode _cx = Right . EncodeCore.literalType + +map :: Ord k => TermCoder k -> TermCoder v -> TermCoder (M.Map k v) +map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) encode decode + where + encode cx g = ExtractCore.map (termCoderEncode keys cx g) (termCoderEncode values cx g) g + decode cx m = Terms.map . M.fromList <$> mapM decodePair (M.toList m) + where + decodePair (k, v) = do + ke <- termCoderDecode keys cx k + ve <- termCoderDecode values cx v + return (ke, ve) + +optional :: TermCoder x -> TermCoder (Y.Maybe x) +optional mel = TermCoder (Types.optional $ termCoderType mel) encode decode + where + encode cx g = ExtractCore.optionalTerm (termCoderEncode mel cx g) g + decode cx mv = Terms.optional <$> case mv of + Nothing -> pure Nothing + Just v -> Just <$> termCoderDecode mel cx v + +-- | A helper to create an Error from a string message and context +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 + encode cx g = ExtractCore.pair (termCoderEncode xCoder cx g) (termCoderEncode yCoder cx g) g + decode cx (x, y) = do + xTerm <- termCoderDecode xCoder cx x + 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 + 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 + where + name = toPrimName n + typ = buildTypeScheme vars $ Types.functionMany [ + termCoderType input1, + termCoderType output] + impl g args = do + ExtractCore.nArgs name 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 + where + name = toPrimName n + typ = buildTypeScheme vars $ Types.functionMany [ + termCoderType input1, + termCoderType input2, + termCoderType output] + impl g args = do + ExtractCore.nArgs name 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 + 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 + arg1 <- termCoderEncode input1 primCx g (args !! 0) + arg2 <- termCoderEncode input2 primCx g (args !! 1) + arg3 <- termCoderEncode input3 primCx g (args !! 2) + termCoderDecode output primCx $ compute arg1 arg2 arg3 + +set :: Ord x => TermCoder x -> TermCoder (S.Set x) +set els = TermCoder (Types.set $ termCoderType els) encode decode + where + encode cx g = ExtractCore.setOf (termCoderEncode els cx g) g + decode cx s = Terms.set . S.fromList <$> mapM (termCoderDecode els cx) (S.toList s) + +string :: TermCoder String +string = TermCoder Types.string encode decode + where + encode _cx g = ExtractCore.string g + decode _cx = Right . Terms.string + +term :: TermCoder Term +term = TermCoder (TypeVariable _Term) encode decode + where + 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 + encode _cx g t = case DecodeCore.type_ g t of + Left err -> Left $ Error.ErrorDecoding err + Right v -> Right v + decode _cx = Right . EncodeCore.type_ + +uint16 :: TermCoder Int +uint16 = TermCoder Types.uint16 encode decode + where + encode _cx g = ExtractCore.uint16 g + decode _cx = Right . Terms.uint16 + +uint32 :: TermCoder Int64 +uint32 = TermCoder Types.uint32 encode decode + where + encode _cx g = ExtractCore.uint32 g + decode _cx = Right . Terms.uint32 + +uint64 :: TermCoder Integer +uint64 = TermCoder Types.uint64 encode decode + where + encode _cx g = ExtractCore.uint64 g + decode _cx = Right . Terms.uint64 + +uint8 :: TermCoder Int16 +uint8 = TermCoder Types.uint8 encode decode + 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 + where + encode _cx _g = Right + decode _cx = Right diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Terms.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Terms.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Terms.hs @@ -0,0 +1,403 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- | A domain-specific language for constructing Hydra terms in Haskell. +module Hydra.Overlay.Haskell.Dsl.Terms where + +import Hydra.Constants +import Hydra.Core +import Hydra.Graph +import Hydra.Packaging (PrimitiveDefinition, primitiveDefinitionName) +import Hydra.Util +import Hydra.Overlay.Haskell.Dsl.Typed.Common +import qualified Hydra.Overlay.Haskell.Dsl.Literals as Literals + +import Prelude hiding (map, product) +import Data.Int +import qualified Data.ByteString as B +import qualified Data.Char as C +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Scientific as Sci +import qualified Data.Set as S + + +-- | Function composition operator: f <.> g creates a function that applies g then f +-- Example: var "stringLength" <.> var "toString" +(<.>) :: Term -> Term -> Term +f <.> g = compose f g + +-- | Term application operator: function @@ argument +-- Example: var "add" @@ int32 1 +(@@) :: Term -> Term -> Term +fun @@ arg = apply fun arg + +-- | Field definition operator: name>: value +-- Example: "name">: string "John" +infixr 0 >: +(>:) :: String -> Term -> Field +name>: term = field name term + +-- | Attach an annotation map to a term, wrapping the map as a TermMap per +-- Hydra's convention (#386 — annotation is now a Term, not a Map). +-- Each Name key is lifted to a TermVariable. +-- Example: annot (M.fromList [(Name "comment", string "A User ID")]) (var "userId") +annot :: M.Map Name Term -> Term -> Term +annot ann term = TermAnnotated $ AnnotatedTerm term (annotationMapAsTerm ann) + +-- | Attach an annotation map to a term (alternative argument order). +-- Example: annotated (var "userId") (M.fromList [(Name "comment", string "A User ID")]) +annotated :: Term -> M.Map Name Term -> Term +annotated term ann = TermAnnotated $ AnnotatedTerm term (annotationMapAsTerm ann) + +-- | Wrap a Map as a TermMap annotation. Each Name key becomes a +-- TermVariable key. The canonical encoding for Hydra's annotation map +-- convention (#386). +annotationMapAsTerm :: M.Map Name Term -> Term +annotationMapAsTerm = TermMap . M.mapKeys TermVariable + +-- | Apply a function term to an argument +-- Example: apply (var "capitalize") (string "arthur") +apply :: Term -> Term -> Term +apply fun arg = TermApplication $ Application fun arg + +-- | Create a bigint literal +-- Example: bigint 9223372036854775808 +bigint :: Integer -> Term +bigint = literal . Literals.bigint + +-- | Create a binary data literal from a ByteString. +-- Example: binary (B.pack [0x48, 0x65, 0x00, 0xff, 0x20, 0x7a, 0x1b, 0x80]) +binary :: B.ByteString -> Term +binary = literal . Literals.binary + +-- | Create a boolean literal +-- Example: boolean True +boolean :: Bool -> Term +boolean = literal . Literals.boolean + +char :: Char -> Term +char = int32 . C.ord + +comparison :: Comparison -> Term +comparison t = case t of + ComparisonEqualTo -> injectUnit _Comparison _Comparison_equalTo + ComparisonLessThan -> injectUnit _Comparison _Comparison_lessThan + ComparisonGreaterThan -> injectUnit _Comparison _Comparison_greaterThan + +-- | Compose two functions (apply g then f) to create a new function +-- Example: compose (var "stringLength") (var "toString") +-- This creates a function equivalent to \x -> stringLength(toString(x)) +-- Function composition applies right-to-left: (f ∘ g)(x) = f(g(x)) +compose :: Term -> Term -> Term +compose f g = lambda "arg_" $ apply f (apply g $ var "arg_") + +-- | Create a constant function that always returns the same value +-- Example: constant true +constant :: Term -> Term +constant = lambda ignoredVariable + +-- | Create an arbitrary-precision decimal literal. +-- Example: decimal (Sci.scientific 314159265359 (-11)) +decimal :: Sci.Scientific -> Term +decimal = literal . Literals.decimal + +-- | Boolean false literal +false :: Term +false = boolean False + +-- | Create a field with the given name and value +-- Example: field "age" (int32 30) +field :: String -> Term -> Field +field n = Field (Name n) + +-- | First element projection function for pairs +first :: Term +first = primitive $ Name "hydra.lib.pairs.first" + +-- | Create a floating-point literal with specified precision +-- Example: float (FloatValueFloat32 3.14) +float :: FloatValue -> Term +float = literal . Literals.float + +-- | Create a float32 literal +-- Example: float32 3.14 +float32 :: Float -> Term +float32 = literal . Literals.float32 + +-- | Create a float64 literal +-- Example: float64 3.14159265359 +float64 :: Double -> Term +float64 = literal . Literals.float64 + +-- | Identity function +identity :: Term +identity = lambda "x_" $ var "x_" + +-- | Create a union value by injecting a value into a specific variant +-- Example: inject (Name "Result") (Name "success") (int32 42) +-- This creates a "Result" union with the "success" variant containing value 42 +-- Use this to construct values of union types at runtime +inject :: Name -> Name -> Term -> Term +inject tname fname term = TermInject $ Injection tname $ Field fname term + +-- | Create a unit variant of a union (convenience function) +-- Example: injectUnit (Name "Result") (Name "success") +-- Equivalent to inject but automatically uses unit as the value +injectUnit :: Name -> Name -> Term +injectUnit tname fname = inject tname fname unit + +-- | Create an int16 literal +-- Example: int16 32767 +int16 :: Int16 -> Term +int16 = literal . Literals.int16 + +-- | Create an int32 literal +-- Example: int32 42 +int32 :: Int -> Term +int32 = literal . Literals.int32 + +-- | Create an int64 literal +-- Example: int64 9223372036854775807 +int64 :: Int64 -> Term +int64 = literal . Literals.int64 + +-- | Create an int8 literal +-- Example: int8 127 +int8 :: Int8 -> Term +int8 = literal . Literals.int8 + +-- | Create an integer literal with specified bit width +-- Example: integer (IntegerValueInt32 42) +integer :: IntegerValue -> Term +integer = literal . Literals.integer + +-- | Create a 'Just' optional value +-- Example: just (string "found") +just :: Term -> Term +just = optional . Just + +-- | Create a lambda function with one parameter +-- Example: lambda "x" (var "x" @@ int32 1) +lambda :: String -> Term -> Term +lambda param body = TermLambda $ Lambda (Name param) Nothing body + +-- | Create a lambda function with a given domain +-- Example: lambdaTyped "x" Types.int32 (list [var "x"]) +lambdaTyped :: String -> Type -> Term -> Term +lambdaTyped param dom body = TermLambda $ Lambda (Name param) (Just dom) body + +-- | Create a multi-parameter lambda function (curried) +-- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y") +-- This creates the function \x.\y.add x y +lambdas :: [String] -> Term -> Term +lambdas params body = case params of + [] -> body + (h:r) -> lambda h $ lambdas r body + +-- | Create a 'Left' either value +-- Example: left (string "error") +left :: Term -> Term +left term = TermEither (Left term) + +-- | Create a let term with any number of bindings +-- Example: lets ["x">: int32 1, "y">: int32 2] (pair (var "x") (var "y")) +lets :: [Field] -> Term -> Term +lets bindings env = TermLet $ Let (toBinding <$> bindings) env + where + toBinding (Field name value) = Binding name value Nothing + +letsTyped :: [(String, Term, TypeScheme)] -> Term -> Term +letsTyped bindings env = TermLet $ Let (toBinding <$> bindings) env + where + toBinding (name, value, ts) = Binding (Name name) value (Just ts) + +-- | Create a list of terms +-- Example: list [int32 1, int32 2, int32 3] +list :: [Term] -> Term +list = TermList + +-- | Create a term from a literal value +-- Example: literal (LiteralString "hello") +literal :: Literal -> Term +literal = TermLiteral + +-- | Create a map/dictionary term +-- Example: map (M.fromList [(string "January", int32 31), (string "February", int32 28)]) +map :: M.Map Term Term -> Term +map = TermMap + +-- | Create a pattern match on a union type +-- Example: match (Name "Result") (Just (string "unknown")) +-- ["success">: lambda "s" (var "processSuccess" @@ var "s"), +-- "error">: lambda "e" (var "handleError" @@ var "e")] +-- This allows handling different cases of a union type with specific logic for each variant. +-- The optional second parameter provides a default case for any unmatched variants. +match :: Name -> Maybe Term -> [Field] -> Term +match tname def fields = TermCases $ CaseStatement tname def (fieldToCaseAlternative <$> fields) + where + -- The DSL builds case alternatives via the same >>: operator used for record/union + -- fields, so call sites still pass [Field]; convert each to a CaseAlternative here. + fieldToCaseAlternative (Field fname fterm) = CaseAlternative fname fterm + +-- | Create a 'Nothing' optional value +nothing :: Term +nothing = optional Nothing + +-- | Create a Maybe (nullable) term +-- Example: optional (Just (string "found")) +optional :: Maybe Term -> Term +optional = TermOptional + +-- | Create a pair +-- Example: pair (string "name") (int32 42) +pair :: Term -> Term -> Term +pair a b = TermPair (a, b) + +-- | Create a reference to a primitive function. +-- | Things that name a primitive. Lets the term/DSL helpers take a generated +-- 'PrimitiveDefinition' directly (@primitive DefStrings.toUpper@) — keeping the def-modules the +-- single source of truth for primitive names (#473) — while still accepting a raw 'Name'. +-- Defined here (the lowest DSL module) so 'Hydra.Overlay.Haskell.Dsl.Prims', 'Hydra.Overlay.Haskell.Dsl.Typed.Terms', and +-- 'Hydra.Overlay.Haskell.Dsl.Typed.Phantoms' can all share one class without an import cycle. +class ToPrimName a where + toPrimName :: a -> Name + +instance ToPrimName Name where + toPrimName = id + +instance ToPrimName PrimitiveDefinition where + toPrimName = primitiveDefinitionName + +-- Uses TermVariable; the name resolves via graphPrimitives fallthrough. +-- Example: primitive DefStrings.length +primitive :: ToPrimName n => n -> Term +primitive = TermVariable . toPrimName + +-- | Create a field projection function +-- Example: project (Name "Person") (Name "firstName") +project :: Name -> Name -> Term +project tname fname = TermProject $ Projection tname fname + +-- | Create a record with named fields of the specified type +-- Example: record (Name "Person") [ +-- "name">: string "John", +-- "age">: int32 30, +-- "email">: string "john@example.com"] +-- Records are products of named fields with values that can be accessed by field name +record :: Name -> [Field] -> Term +record tname fields = TermRecord $ Record tname fields + +-- | Create a 'Right' either value +-- Example: right (int32 42) +right :: Term -> Term +right term = TermEither (Right term) + +-- | Second element projection function for pairs +second :: Term +second = primitive $ Name "hydra.lib.pairs.second" + +-- | Create a set of terms +-- Example: set (S.fromList [string "a", string "b", string "c"]) +set :: S.Set Term -> Term +set = TermSet + +-- | Create a string literal +-- Example: string "hello world" +string :: String -> Term +string = TermLiteral . LiteralString + +triple :: Term -> Term -> Term -> Term +triple a b c = pair a (pair b c) + +-- | Boolean true literal +true :: Term +true = boolean True + +-- | Create a tuple using nested pairs (deprecated: use pair directly) +-- Example: tuple2 a b creates pair a b +-- Example: tuple3 a b c creates pair a (pair b c) +tuple :: [Term] -> Term +tuple [] = unit +tuple [a] = a +tuple [a, b] = pair a b +tuple (a:rest) = pair a (tuple rest) + +-- | Create a 2-tuple (same as pair) +tuple2 :: Term -> Term -> Term +tuple2 = pair + +tuple3 :: Term -> Term -> Term -> Term +tuple3 a b c = pair a (pair b c) + +tuple4 :: Term -> Term -> Term -> Term -> Term +tuple4 a b c d = pair a (pair b (pair c d)) + +tuple5 :: Term -> Term -> Term -> Term -> Term -> Term +tuple5 a b c d e = pair a (pair b (pair c (pair d e))) + +tyapp :: Term -> Type -> Term +tyapp term typ = TermTypeApplication $ TypeApplicationTerm term typ + +tyapps = typeApplication + +tylam :: String -> Term -> Term +tylam var body = TermTypeLambda $ TypeLambda (Name var) body + +tylams :: [String] -> Term -> Term +tylams vars body = L.foldl (\b v -> TermTypeLambda $ TypeLambda (Name v) b) body $ L.reverse vars + +-- | Apply type arguments to a polymorphic term +-- Example: typeApplication (var "map") [Types.int32, Types.string] +-- This instantiates a polymorphic function with concrete types. +-- For instance, if 'map' has type 'forall a b. (a -> b) -> list a -> list b', +-- the example would instantiate it to '(int32 -> string) -> list int32 -> list string'. +typeApplication :: Term -> [Type] -> Term +typeApplication term types = L.foldl (\t ty -> TermTypeApplication $ TypeApplicationTerm t ty) term types + +-- | Create a type abstraction (universal quantification) +-- Example: typeLambda [Name "a", Name "b"] (lambdaTyped "f" (Types.function (Types.var "a") (Types.var "b")) +-- (lambdaTyped "x" (Types.var "a") (var "f" @@ var "x"))) +-- This creates a polymorphic term with type variables. +-- The example creates a higher-order function with type 'forall a b. (a -> b) -> a -> b', +-- which is the polymorphic apply function that works for any types a and b. +typeLambda :: [Name] -> Term -> Term +typeLambda vars body = L.foldl (\b v -> TermTypeLambda $ TypeLambda v b) body vars + +-- | Create a uint16 literal +-- Example: uint16 65535 +uint16 :: Int -> Term +uint16 = literal . Literals.uint16 + +-- | Create a uint32 literal +-- Example: uint32 4294967295 +uint32 :: Int64 -> Term +uint32 = literal . Literals.uint32 + +-- | Create a uint64 literal +-- Example: uint64 18446744073709551615 +uint64 :: Integer -> Term +uint64 = literal . Literals.uint64 + +-- | Create a uint8 literal +-- Example: uint8 255 +uint8 :: Int16 -> Term +uint8 = literal . Literals.uint8 + +-- | Unit value (empty record) +unit :: Term +unit = TermUnit + +-- | Create an unwrap function for a wrapped type +-- Example: unwrap (Name "Email") +unwrap :: Name -> Term +unwrap = TermUnwrap + +-- | Create a variable reference +-- Example: var "x" +var :: String -> Term +var = TermVariable . Name + +-- | Create a wrapped term +-- Example: wrap (Name "Email") (string "user@example.com") +wrap :: Name -> Term -> Term +wrap name term = TermWrap $ WrappedTerm name term diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Tests.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Tests.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Tests.hs @@ -0,0 +1,29 @@ +-- | Convenience functions for writing Hydra test cases + +module Hydra.Overlay.Haskell.Dsl.Tests ( + module Hydra.Testing, + module Hydra.Overlay.Haskell.Libraries, + module Hydra.Overlay.Haskell.Dsl.Terms, + module Hydra.Overlay.Haskell.Dsl.Tests, +) where + +import Hydra.Core +import Hydra.Testing +import Hydra.Overlay.Haskell.Libraries +import Hydra.Overlay.Haskell.Dsl.Terms + +import qualified Data.List as L +import qualified Data.Set as S + + +intList :: [Int] -> Term +intList els = list (int32 <$> els) + +intListList :: [[Int]] -> Term +intListList lists = list (intList <$> lists) + +stringList :: [String] -> Term +stringList els = list (string <$> els) + +stringSet :: S.Set String -> Term +stringSet strings = set $ S.fromList $ string <$> S.toList strings diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Base.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Base.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Base.hs @@ -0,0 +1,28 @@ +-- | A basis for other DSLs which deal with term-encoded expressions. + +module Hydra.Overlay.Haskell.Dsl.Typed.Base ( + module Hydra.Overlay.Haskell.Dsl.Typed.Phantoms, + module Hydra.Overlay.Haskell.Dsl.Typed.Base, + module Hydra.Overlay.Haskell.Libraries, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms(asTerm, AsTerm(..), definitionInModule, el, firstClassType, opt) +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Core as Core +import Hydra.Overlay.Haskell.Libraries + +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +infixr 0 >: +(>:) :: String -> a -> (TypedTerm Name, a) +n >: d = (name n, d) + +infixr 0 >>: +(>>:) :: Name -> a -> (TypedTerm Name, a) +n >>: d = (Core.nameLift n, d) + +name :: String -> TypedTerm Name +name s = Core.nameLift $ Name s diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Common.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Common.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Common.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- | Common IsString instances for Term and Type, enabling OverloadedStrings + +module Hydra.Overlay.Haskell.Dsl.Typed.Common where + +import Hydra.Core +import Hydra.Typed + +import Data.String(IsString(..)) + + +instance IsString Type where fromString = TypeVariable . Name +instance IsString Term where fromString = TermLiteral . LiteralString +instance IsString (TypedTerm a) where fromString = TypedTerm . TermLiteral . LiteralString diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Core.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Core.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Core.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Haskell-specific convenience layer over the generated Hydra.Dsl.Core module. +-- Re-exports all generated DSL functions and adds AsTerm-flexible overrides +-- for functions commonly called with TypedBinding arguments. + +module Hydra.Overlay.Haskell.Dsl.Typed.Core ( + module Hydra.Dsl.Core, + module Hydra.Overlay.Haskell.Dsl.Typed.Core, + nameLift, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.AsTerm +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms (nameLift, var, (~>)) +import Hydra.Dsl.Core hiding (binding, injection, typeVariable) +import qualified Hydra.Dsl.Core as Gen + +-- For helpers +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 Data.Map as M +import Prelude hiding (map, product) + + +-- | AsTerm-flexible overrides of generated functions. +-- These allow passing TypedBinding values where TypedTerm is expected. + +binding :: AsTerm t Term => TypedTerm Name -> t -> TypedTerm (Maybe TypeScheme) -> TypedTerm Binding +binding n t ts = Gen.binding n (asTerm t) ts + +equalNameList_ :: TypedTerm [Name] -> TypedTerm [Name] -> TypedTerm Bool +equalNameList_ lefts rights = Logic.and + (Equality.equal (Lists.length lefts) (Lists.length rights)) + (ands $ Lists.zipWith equalName lefts rights) + where + equalName = "left" ~> "right" ~> Equality.equal + (Gen.unName (var "left" :: TypedTerm Name)) + (Gen.unName (var "right" :: TypedTerm Name)) + -- Fold a list of booleans with logical AND (True for the empty list). + -- The generated Hydra.Dsl.Lib.Logic has no 'ands' helper, so fold inline. + ands bools = Lists.foldl ("acc" ~> "x" ~> Logic.and (var "acc") (var "x")) true bools + true = TypedTerm (TermLiteral (LiteralBoolean True)) :: TypedTerm Bool + +equalName_ :: TypedTerm Name -> TypedTerm Name -> TypedTerm Bool +equalName_ left right = Equality.equal (Gen.unName left) (Gen.unName right) + +false :: TypedTerm Term +false = termLiteral $ literalBoolean $ TypedTerm $ TermLiteral $ LiteralBoolean False + +injection :: AsTerm t Name => t -> TypedTerm Field -> TypedTerm Injection +injection n f = Gen.injection (asTerm n) f + +typeVariable :: AsTerm t Name => t -> TypedTerm Type +typeVariable n = Gen.typeVariable (asTerm n) + + +-- | Non-standard helpers (used in kernel source modules) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/DeepCore.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/DeepCore.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/DeepCore.hs @@ -0,0 +1,172 @@ +-- | A domain-specific language for constructing Hydra terms in Haskell. +-- +-- This DSL provides helpers for constructing "deep" terms - i.e., terms that +-- represent Hydra terms as data (Term values), as opposed to the shallow DSL +-- that works at the Haskell level. +module Hydra.Overlay.Haskell.Dsl.Typed.DeepCore where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.Dsl.Terms (ToPrimName(..)) +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Core as Core +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Phantoms as P + +import qualified Data.Char as C +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S + + +-------------------------------------------------------------------------------- +-- Application operators +-------------------------------------------------------------------------------- + +-- | Apply a function term to an argument term (infix operator, alias) +(@@@) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +fun @@@ arg = apply fun arg + +-- | Apply a function term to an argument term +apply :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +apply lhs rhs = Core.termApplication $ Core.application lhs rhs + +-------------------------------------------------------------------------------- +-- Case statements and pattern matching +-------------------------------------------------------------------------------- + +cases :: Name -> TypedTerm Term -> TypedTerm (Maybe Term) -> [TypedTerm CaseAlternative] -> TypedTerm Term +cases tname arg dflt alts = match tname dflt alts @@@ arg + +-- | Create a field (e.g. for injection payloads) +field :: Name -> TypedTerm Term -> TypedTerm Field +field fname body = Core.field (Core.nameLift fname) body + +-- | Create a case alternative (a variant tag together with its handler) for case matching +caseAlternative :: Name -> TypedTerm Term -> TypedTerm CaseAlternative +caseAlternative aname handler = Core.caseAlternative (Core.nameLift aname) handler + +-- | Create a union case statement with optional default case +match :: Name -> TypedTerm (Maybe Term) -> [TypedTerm CaseAlternative] -> TypedTerm Term +match tname dflt alts = Core.termCases $ + Core.caseStatement + (Core.nameLift tname) + dflt + (P.list alts) + +-------------------------------------------------------------------------------- +-- Functions and lambdas +-------------------------------------------------------------------------------- + +constant :: TypedTerm Term -> TypedTerm Term +constant = lambda ignoredVariable + +-- | Create a lambda term with a variable name and body +lambda :: String -> TypedTerm Term -> TypedTerm Term +lambda v body = Core.termLambda $ Core.lambda (Core.name (P.string v)) P.nothing $ body + +-- | Create a lambda term with a dynamic parameter name, optional domain, and body +lambdaTyped :: TypedTerm Name -> TypedTerm (Maybe Type) -> TypedTerm Term -> TypedTerm Term +lambdaTyped name domain body = Core.termLambda $ Core.lambda name domain body + +-- | Create a reference to a primitive function. +-- Uses termVariable; the name resolves via graphPrimitives fallthrough. +primitive :: ToPrimName n => n -> TypedTerm Term +primitive = Core.termVariable . Core.nameLift . toPrimName + +-- TODO: this is probably equivalent to `primitive`. +-- | Create a reference to a primitive function using encodedName +-- (for primitives that need namespace encoding) +primitiveEncoded :: ToPrimName n => n -> TypedTerm Term +primitiveEncoded = Core.termVariable . P.encodedName . toPrimName + +-------------------------------------------------------------------------------- +-- Projections and eliminations +-------------------------------------------------------------------------------- + +-- | Create a record field projection +project :: Name -> Name -> TypedTerm Term +project tname fname = Core.termProject $ + Core.projection (Core.nameLift tname) (Core.nameLift fname) + +unwrap :: Name -> TypedTerm Term +unwrap name = unwrapDynamic (Core.nameLift name) + +-- | Create an unwrap elimination for a wrapped type +unwrapDynamic :: TypedTerm Name -> TypedTerm Term +unwrapDynamic tname = Core.termUnwrap tname + +-------------------------------------------------------------------------------- +-- Literals and basic terms +-------------------------------------------------------------------------------- + +-- | Create a string literal term +string :: TypedTerm String -> TypedTerm Term +string s = Core.termLiteral $ Core.literalString s + +-- | Create a unit term +unit :: TypedTerm Term +unit = Core.termUnit + +-- | Create a variable reference term +var :: String -> TypedTerm Term +var s = Core.termVariable $ Core.name $ P.string s + +-------------------------------------------------------------------------------- +-- Compound terms (records, unions, wraps, lists) +-------------------------------------------------------------------------------- + +-- | Create an Either term (left or right) +either :: TypedTerm (Either Term Term) -> TypedTerm Term +either e = Core.termEither e + +-- | Create a union injection term +injection :: Name -> TypedTerm Field -> TypedTerm Term +injection tname fld = Core.termInject $ Core.injection (Core.nameLift tname) fld + +-- | Create a Just term +just :: TypedTerm Term -> TypedTerm Term +just (TypedTerm t) = TypedTerm $ TermOptional $ Just t + +left :: TypedTerm Term -> TypedTerm Term +left (TypedTerm t) = Core.termEither $ TypedTerm $ TermEither $ Left t + +-- | Create a single let binding +letn :: String -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term +letn name value body = lets [(name, value)] body + +-- | Create a let expression with bindings and a body +-- Each binding is a (name, term) pair +lets :: [(String, TypedTerm Term)] -> TypedTerm Term -> TypedTerm Term +lets bindings body = Core.termLet $ Core.let_ + (P.list [Core.binding (Core.name (P.string n)) t P.nothing | (n, t) <- bindings]) + body + +-- | Create a list term from a list of terms +list :: TypedTerm [Term] -> TypedTerm Term +list terms = Core.termList terms + +map :: TypedTerm (M.Map Term Term) -> TypedTerm Term +map terms = Core.termMap terms + +-- | Create a Nothing term +nothing :: TypedTerm Term +nothing = TypedTerm $ TermOptional Nothing + +pair :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +pair (TypedTerm first) (TypedTerm second) = Core.termPair $ TypedTerm $ TermPair (first, second) + +-- | Create a record term with a type name and fields +record :: Name -> [TypedTerm Field] -> TypedTerm Term +record tname fields = Core.termRecord $ Core.record (Core.nameLift tname) (P.list fields) + +ref :: TypedTermDefinition a -> TypedTerm Term +ref (TypedTermDefinition name _) = Core.termVariable $ Core.nameLift name + +right :: TypedTerm Term -> TypedTerm Term +right (TypedTerm t) = Core.termEither $ TypedTerm $ TermEither $ Right t + +-- | Create a wrap term with a type name and body +wrap :: Name -> TypedTerm Term -> TypedTerm Term +wrap tname body = Core.termWrap $ Core.wrappedTerm (Core.nameLift tname) body + +-- | Create a wrap term with a dynamic type name (TypedTerm Name) +wrapDynamic :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term +wrapDynamic tname body = Core.termWrap $ Core.wrappedTerm tname body diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Graph.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Graph.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Graph.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Haskell-specific convenience layer over the generated Hydra.Dsl.Graph module. +-- Re-exports all generated DSL functions and adds non-standard helpers. + +module Hydra.Overlay.Haskell.Dsl.Typed.Graph ( + module Hydra.Dsl.Graph, + module Hydra.Overlay.Haskell.Dsl.Typed.Graph, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms +import Hydra.Dsl.Graph + +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Sets as Sets + + +-- | Non-standard helpers + +comparisonEqualTo :: TypedTerm Comparison +comparisonEqualTo = injectUnit _Comparison _Comparison_equalTo + +comparisonGreaterThan :: TypedTerm Comparison +comparisonGreaterThan = injectUnit _Comparison _Comparison_greaterThan + +comparisonLessThan :: TypedTerm Comparison +comparisonLessThan = injectUnit _Comparison _Comparison_lessThan + +emptyGraph :: TypedTerm Graph +emptyGraph = graph + Maps.empty -- boundTerms + Maps.empty -- boundTypes + Maps.empty -- classConstraints + Sets.empty -- lambdaVariables + Maps.empty -- metadata + Maps.empty -- primitives + Maps.empty -- schemaTypes + Sets.empty -- typeVariables diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Literals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Literals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Literals.hs @@ -0,0 +1,80 @@ +-- | A DSL for constructing literal terms using Haskell's built-in datatypes + +module Hydra.Overlay.Haskell.Dsl.Typed.Literals where + +import Hydra.Typed +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms + +import Data.Int +import qualified Data.ByteString as B +import qualified Data.Scientific as Sci + + +-- Binary is now properly represented as ByteString +type Binary = B.ByteString + +bigint :: Integer -> TypedTerm Integer +bigint = TypedTerm . Terms.bigint + +binary :: Binary -> TypedTerm Binary +binary = TypedTerm . Terms.binary + +bool :: Bool -> TypedTerm Bool +bool = TypedTerm . Terms.boolean + +boolean :: Bool -> TypedTerm Bool +boolean = bool + +char :: Char -> TypedTerm Int +char = TypedTerm . Terms.char + +decimal :: Sci.Scientific -> TypedTerm Sci.Scientific +decimal = TypedTerm . Terms.decimal + +double :: Double -> TypedTerm Double +double = float64 + +false :: TypedTerm Bool +false = bool False + +float :: Float -> TypedTerm Float +float = float32 + +float32 :: Float -> TypedTerm Float +float32 = TypedTerm . Terms.float32 + +float64 :: Double -> TypedTerm Double +float64 = TypedTerm . Terms.float64 + +int :: Int -> TypedTerm Int +int = int32 + +int16 :: Int16 -> TypedTerm Int16 +int16 = TypedTerm . Terms.int16 + +int32 :: Int -> TypedTerm Int +int32 = TypedTerm . Terms.int32 + +int64 :: Int64 -> TypedTerm Int64 +int64 = TypedTerm . Terms.int64 + +int8 :: Int8 -> TypedTerm Int8 +int8 = TypedTerm . Terms.int8 + +string :: String -> TypedTerm String +string = TypedTerm . Terms.string + +true :: TypedTerm Bool +true = bool True + +uint16 :: Int -> TypedTerm Int +uint16 = TypedTerm . Terms.uint16 + +uint32 :: Int64 -> TypedTerm Int64 +uint32 = TypedTerm . Terms.uint32 + +uint64 :: Integer -> TypedTerm Integer +uint64 = TypedTerm . Terms.uint64 + +uint8 :: Int16 -> TypedTerm Int16 +uint8 = TypedTerm . Terms.uint8 diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Phantoms.hs @@ -0,0 +1,522 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | Term-level DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions. +-- The phantom types provide static type checking in Haskell prior to Hydra's runtime type checking. +module Hydra.Overlay.Haskell.Dsl.Typed.Phantoms ( + module Hydra.Overlay.Haskell.Dsl.Typed.Phantoms, + module Hydra.Overlay.Haskell.Dsl.Typed.Literals, + module Hydra.Overlay.Haskell.AsTerm, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.AsTerm +import Hydra.Overlay.Haskell.Dsl.Typed.Common +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 Hydra.Encoding (encodeBindingName) +import Hydra.Decoding (decodeBindingName) + +import Prelude hiding ((++)) +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Hydra.Overlay.Haskell.Dsl.Prims as Prims +import qualified Hydra.Lib.Eithers as DefEithers +import qualified Hydra.Lib.Lists as DefLists +import qualified Hydra.Lib.Math as DefMath +import qualified Hydra.Lib.Optionals as DefOptionals +import qualified Hydra.Lib.Strings as DefStrings + + +-- Operators + +infixr 0 ~> +(~>) :: String -> TypedTerm x -> TypedTerm (a -> b) +name ~> body = lambda name body + +infixl 1 <~ +(<~) :: String -> TypedTerm a -> TypedTerm b -> TypedTerm b +name <~ value = let1 name value + +infixl 1 <<~ +(<<~) :: AsTerm t (Either e a) => String -> t -> TypedTerm (Either e b) -> TypedTerm (Either e b) +name <<~ def = eitherBind name (asTerm def) + +-- | Function composition operator: f <.> g creates a function that applies g then f +-- Example: toString <.> increment +-- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) +(<.>) :: (AsTerm f (b -> c), AsTerm g (a -> b)) => f -> g -> TypedTerm (a -> c) +f <.> g = compose (asTerm f) (asTerm g) + +-- | Function application operator: function @@ argument +-- Example: add @@ int32 1 +-- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) +(@@) :: (AsTerm f (a -> b), AsTerm g a) => f -> g -> TypedTerm b +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) + +-- | Field definition operator for records: name>: value +-- Example: "name">: string "John" +-- Accepts TypedTerm or TypedBinding (via AsTerm) +infixr 0 >: +(>:) :: AsTerm t a => String -> t -> Field +name>: term = Field (Name name) (unTypedTerm $ asTerm term) + +-- | Field definition operator with pre-constructed name: fname>>: value +-- Example: _Person_name>>: string "John" +-- Accepts TypedTerm or TypedBinding (via AsTerm) +infixr 0 >>: +(>>:) :: AsTerm t a => Name -> t -> Field +fname >>: d = field fname (asTerm d) + +-- | Add an annotation to a term +-- Example: annot (Name "deprecated") (Just (boolean True)) myFunction +annot :: Name -> Maybe Term -> TypedTerm a -> TypedTerm a +annot key mvalue (TypedTerm term) = TypedTerm $ Ann.annotateTerm key mvalue term + +-- | Apply a function to an argument +-- Example: apply (var "add") (int32 1) +apply :: TypedTerm (a -> b) -> TypedTerm a -> TypedTerm b +apply (TypedTerm lhs) (TypedTerm rhs) = TypedTerm $ Terms.apply lhs rhs + + + +-- | Apply a named case match to an argument +-- Example: cases resultTypeName myResult Nothing [onSuccess, onError] +-- See also: 'match' +cases :: Name -> TypedTerm a -> Maybe (TypedTerm b) -> [Field] -> TypedTerm b +cases name arg dflt fields = TypedTerm $ Terms.apply (Terms.match name (unTypedTerm <$> dflt) fields) (unTypedTerm arg) + +-- | Compose two functions (g then f) +-- Example: compose (var "stringLength") (var "toString") +-- Accepts TypedTerm or TypedBinding for both operands (via AsTerm) +compose :: (AsTerm f (b -> c), AsTerm g (a -> b)) => f -> g -> TypedTerm (a -> c) +compose f g = TypedTerm $ Terms.compose (unTypedTerm $ asTerm f) (unTypedTerm $ asTerm g) + +-- | Create a constant function that always returns the same value +-- Example: constant true +-- Accepts TypedTerm or TypedBinding (via AsTerm) +constant :: AsTerm t a => t -> TypedTerm (b -> a) +constant t = TypedTerm $ Terms.constant (unTypedTerm $ asTerm t) + +-- | Get a reference to a decoder function in hydra.decode.core for a given type name +-- The decoder takes a graph context and a term, returning either a decoding error or the decoded value +decoderFor :: Name -> TypedTerm (Graph -> Term -> Prelude.Either DecodingError a) +decoderFor typeName = var $ unName $ decodeBindingName typeName + +-- | Create a definition in a module +-- Example: definitionInModule myModule "addInts" (lambda "x" (lambda "y" (add @@ var "x" @@ var "y"))) +definitionInModule :: Module -> String -> TypedTerm a -> TypedTermDefinition a +definitionInModule mod = definitionInModuleName $ moduleName mod + +-- | Create a definition in a namespace +-- Example: definitionInModuleName (ModuleName "com.example") "addInts" myFunction +definitionInModuleName :: ModuleName -> String -> TypedTerm a -> TypedTermDefinition a +definitionInModuleName ns lname = TypedTermDefinition $ unqualifyName $ QualifiedName (Just ns) lname + +-- | Add documentation to a term +-- Example: doc "Adds two integers" addFunction +-- Accepts TypedTerm or TypedBinding (via AsTerm) +doc :: AsTerm t a => String -> t -> TypedTerm a +doc s t = TypedTerm $ setTermDescription (Just s) (unTypedTerm $ asTerm t) + +-- | Add documentation with line wrapping at the specified width +-- Example: docWrapped 80 "This is a long documentation string that will be wrapped..." myFunction +docWrapped :: Int -> String -> TypedTerm a -> TypedTerm a +docWrapped len = doc . wrapLine len + +-- | Bind over Either: extracts the Right value into a variable, short-circuiting on Left +eitherBind :: AsTerm t (Either e a) => String -> t -> TypedTerm (Either e b) -> TypedTerm (Either e b) +eitherBind v def body = primitive2 (Prims.primName DefEithers.bind) (asTerm def) $ lambda v $ body + +-- | Convert a typed element to an untyped element (legacy name, prefer 'toBinding') +-- Example: el (definitionInModule myModule "addInts" myFunction) +el :: TypedBinding a -> Binding +el = toBinding + +encodedBinary :: TypedTerm String -> TypedTerm Term +encodedBinary = encodedLiteral . inject _Literal _Literal_binary + +encodedBoolean :: TypedTerm Bool -> TypedTerm Term +encodedBoolean = encodedLiteral . inject _Literal _Literal_boolean + +encodedCase :: AsTerm t (a -> Term) => Name -> Name -> t -> Field +encodedCase tname fname enc = field fname $ "v" ~> encodedVariant tname fname (enc @@ var "v") + +encodedEither :: TypedTerm (Prelude.Either a b) -> TypedTerm Term +encodedEither = inject _Term _Term_either + +encodedField :: Name -> TypedTerm Term -> TypedTerm Term +encodedField fname term = encodedFieldRaw (encodedName fname) term + +encodedFieldRaw :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term +encodedFieldRaw (TypedTerm fname) (TypedTerm term) = TypedTerm $ Terms.record _Field [ + Field _Field_name fname, + Field _Field_term term] + +encodedFloatValue :: TypedTerm FloatValue -> TypedTerm Term +encodedFloatValue = encodedLiteral . inject _Literal _Literal_float + +encodedInjection :: Name -> Name -> TypedTerm Term -> TypedTerm Term +encodedInjection tname fname term = TypedTerm $ Terms.record _Injection [ + field _Injection_typeName $ encodedName tname, + field _Injection_field $ encodedField fname term] + +encodedInt32 :: TypedTerm Int -> TypedTerm Term +encodedInt32 v = encodedIntegerValue $ inject _IntegerValue _IntegerValue_int32 v + +encodedIntegerValue :: TypedTerm IntegerValue -> TypedTerm Term +encodedIntegerValue = encodedLiteral . inject _Literal _Literal_integer + +encodedList :: TypedTerm [a] -> TypedTerm Term +encodedList = inject _Term _Term_list + +encodedLiteral :: TypedTerm Literal -> TypedTerm Term +encodedLiteral = inject _Term _Term_literal + +encodedMap :: TypedTerm (M.Map k v) -> TypedTerm Term +encodedMap = inject _Term _Term_map + +encodedName :: Name -> TypedTerm Name +encodedName = wrap _Name . string . unName + +encodedOptional :: TypedTerm (Maybe a) -> TypedTerm Term +encodedOptional = inject _Term _Term_optional + +encodedPair :: TypedTerm (a, b) -> TypedTerm Term +encodedPair = inject _Term _Term_pair + +encodedRecord :: Name -> [Field] -> TypedTerm Term +encodedRecord tname fields = TypedTerm $ Terms.inject _Term _Term_record $ Terms.record _Record [ + field _Record_typeName $ encodedName tname, + field _Record_fields $ list (encField <$> fields)] + where + encField (Field fname term) = encodedField fname $ TypedTerm term + +encodedSet :: TypedTerm (S.Set a) -> TypedTerm Term +encodedSet = inject _Term _Term_set + +encodedString :: TypedTerm String -> TypedTerm Term +encodedString = encodedLiteral . inject _Literal _Literal_string + +encodedUnion :: TypedTerm Term -> TypedTerm Term +encodedUnion = inject _Term _Term_inject + +encodedUnit :: TypedTerm Term +encodedUnit = injectUnit _Term _Term_unit + +encodedVariant :: Name -> Name -> TypedTerm Term -> TypedTerm Term +encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term + +encodedWrappedTerm :: Name -> TypedTerm Term -> TypedTerm Term +encodedWrappedTerm name = encodedWrappedTermRaw (encodedName name) + +encodedWrappedTermRaw :: TypedTerm Name -> TypedTerm Term -> TypedTerm Term +encodedWrappedTermRaw (TypedTerm name) (TypedTerm term) = TypedTerm $ Terms.inject _Term _Term_wrap $ Terms.record _WrappedTerm [ + Field _WrappedTerm_typeName name, + Field _WrappedTerm_body term] + +-- | Get a reference to an encoder function in hydra.encode.core for a given type name +encoderFor :: Name -> TypedTerm (a -> Term) +encoderFor typeName = var $ unName $ encodeBindingName typeName + +-- | Create a field with the given name and value +-- Example: field (Name "age") (int32 30) +field :: Name -> TypedTerm a -> Field +field fname (TypedTerm val) = Field fname val + +-- | Mark a type as first-class +-- Example: firstClassType (record ...) +firstClassType :: TypedTerm Type -> TypedTerm Type +firstClassType typ = annot keyFirstClassType (Just $ Terms.boolean True) typ + +-- | Create a fold function to process lists +-- Example: fold (lambda "acc" (lambda "x" (add @@ var "acc" @@ var "x"))) +fold :: AsTerm t (b -> a -> b) => t -> TypedTerm (b -> [a] -> b) +fold f = (primitive (Prims.primName DefLists.foldl)) @@ asTerm f + +-- | Identity function that returns its argument unchanged +-- Example: identity +identity :: TypedTerm (a -> a) +identity = TypedTerm Terms.identity + +-- | Create a union injection +-- Example: inject (Name "Result") (Name "success") (string "ok") +inject :: (AsName t, AsName f) => t -> f -> TypedTerm a -> TypedTerm b +inject n fn (TypedTerm term) = TypedTerm $ Terms.inject (asName n) (asName fn) term + +-- | Create a function that injects its argument into a union variant +-- Example: injectLambda (Name "Result") (Name "success") +injectLambda :: Name -> Name -> TypedTerm (a -> b) +injectLambda name fname = lambda "injected_" $ inject name fname $ var "injected_" + +-- | Create a unit variant of a union +-- Example: injectUnit (Name "Result") (Name "success") +injectUnit :: (AsName t, AsName f) => t -> f -> TypedTerm a +injectUnit n fn = TypedTerm $ Terms.inject (asName n) (asName fn) Terms.unit + +-- | Create a 'Just' optional value +-- Example: just (string "found") +-- Accepts TypedTerm or TypedBinding (via AsTerm) +just :: AsTerm t a => t -> TypedTerm (Maybe a) +just t = TypedTerm $ Terms.just (unTypedTerm $ asTerm t) + +-- | Function that wraps a value in 'Just' +-- Example: just_ @@ myValue +just_ :: TypedTerm (a -> Maybe a) +just_ = TypedTerm $ Terms.lambda "just_" $ Terms.just $ Terms.var "just_" + +-- | Create a lambda function with one parameter +-- Example: lambda "x" (var "add" @@ var "x" @@ int32 1) +lambda :: String -> TypedTerm x -> TypedTerm (a -> b) +lambda v (TypedTerm body) = TypedTerm $ Terms.lambda v body + +-- | Create a multi-parameter lambda function +-- Example: lambdas ["x", "y"] (add @@ var "x" @@ var "y") +lambdas :: [String] -> TypedTerm x -> TypedTerm (a -> b) +lambdas params (TypedTerm body) = TypedTerm $ Terms.lambdas params body + +-- | Create a 'Left' either value +-- Example: left (string "error") +left :: TypedTerm a -> TypedTerm (Either a b) +left (TypedTerm term) = TypedTerm $ Terms.left term + +-- | Function that wraps a value in 'Left' +-- Example: left_ @@ myValue +left_ :: TypedTerm (a -> Either a b) +left_ = TypedTerm $ Terms.lambda "left_" $ Terms.left $ Terms.var "left_" + +let1 :: String -> TypedTerm a -> TypedTerm b -> TypedTerm b +let1 name (TypedTerm value) (TypedTerm env) = TypedTerm $ TermLet $ Let [Binding (Name name) value Nothing] env + +-- | Create a let expression with multiple bindings +-- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y") +lets :: [Field] -> TypedTerm a -> TypedTerm a +lets fields (TypedTerm env) = TypedTerm $ TermLet $ Let (toBinding <$> fields) env + where + toBinding (Field name value) = Binding name value Nothing + +-- | Create a list of terms +-- Example: list [int32 1, int32 2, int32 3] +-- Accepts TypedTerm or TypedBinding elements (via AsTerm) +list :: AsTerm t a => [t] -> TypedTerm [a] +list els = TypedTerm $ Terms.list (unTypedTerm . asTerm <$> els) + +-- | Create a map/dictionary term +-- Example: map (M.fromList [(string "a", int32 1), (string "b", int32 2)]) +map :: M.Map (TypedTerm a) (TypedTerm b) -> TypedTerm (M.Map a b) +map = TypedTerm . Terms.map . M.fromList . fmap fromTypedTerm . M.toList + where + fromTypedTerm (TypedTerm k, TypedTerm v) = (k, v) + +-- | Create a pattern match on a union term +-- Example: match (Name "Result") (Just $ string "what?") ["success">: string "yay", "error">: string "boo"] +match :: AsName n => n -> Maybe (TypedTerm b) -> [Field] -> TypedTerm (a -> b) +match n dflt fields = TypedTerm $ Terms.match (asName n) (unTypedTerm <$> dflt) fields + +-- | Lift a Haskell Name value to a phantom-typed TypedTerm Name +nameLift :: Name -> TypedTerm Name +nameLift (Name n) = wrap _Name $ string n + +-- | Create a 'Nothing' optional value +-- Example: nothing +nothing :: TypedTerm (Maybe a) +nothing = TypedTerm Terms.nothing + +-- | Create an optional value from a Maybe +-- Example: opt (Just myValue) +opt :: Maybe (TypedTerm a) -> TypedTerm (Maybe a) +opt mc = TypedTerm $ Terms.optional (unTypedTerm <$> mc) + +optCases :: AsTerm f (a -> b) => TypedTerm (Maybe a) -> TypedTerm b -> f -> TypedTerm b +optCases arg ifNothing ifJust = primitive3 (Name "hydra.lib.optionals.cases") arg ifNothing (asTerm ifJust) + +-- | Create a pair +-- Example: pair (string "age") (int32 32) +-- Accepts TypedTerm or TypedBinding (via AsTerm) +pair :: (AsTerm t1 a, AsTerm t2 b) => t1 -> t2 -> TypedTerm (a, b) +pair l r = TypedTerm $ Terms.pair (unTypedTerm $ asTerm l) (unTypedTerm $ asTerm r) + +-- | Primitive function by name +-- Example: primitive (Name "hydra.lib.strings.length") +primitive :: Terms.ToPrimName n => n -> TypedTerm a +primitive = TypedTerm . Terms.primitive + +-- | Apply a primitive function to one argument +-- Example: primitive1 DefMath.abs (int32 (-5)) +primitive1 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b +primitive1 n (TypedTerm a) = TypedTerm $ Terms.primitive n Terms.@@ a + +-- | Apply a primitive function to two arguments +-- Example: primitive2 DefMath.add (int32 2) (int32 3) +primitive2 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b -> TypedTerm c +primitive2 n (TypedTerm a) (TypedTerm b) = TypedTerm $ Terms.primitive n Terms.@@ a Terms.@@ b + +-- | Apply a primitive function to three arguments +-- Example: primitive3 DefStrings.replace (string "hello") (string "e") (string "a") +primitive3 :: Terms.ToPrimName n => n -> TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d +primitive3 n (TypedTerm a) (TypedTerm b) (TypedTerm c) = TypedTerm $ Terms.primitive n Terms.@@ a Terms.@@ b Terms.@@ c + +-- | Extract a field from a record +-- Example: project (Name "Person") (Name "name") +project :: (AsName t, AsName f) => t -> f -> TypedTerm (a -> b) +project n fn = TypedTerm $ Terms.project (asName n) (asName fn) + +-- | Create a record with named fields +-- Example: record (Name "Person") [field (Name "name") (string "John"), field (Name "age") (int32 30)] +record :: AsName n => n -> [Field] -> TypedTerm a +record n fields = TypedTerm $ Terms.record (asName n) fields + +-- | Reify a Haskell-level meta-function over phantom-typed terms into a first-class +-- term-level function. See also 'reify2' for the binary form. +-- Example: @reify Literals.showInt32@ has type @TypedTerm (Int -> String)@ +reify :: (TypedTerm a -> TypedTerm b) -> TypedTerm (a -> b) +reify f = case (unTypedTerm $ f $ var "x") of + TermApplication (Application lhs _) -> TypedTerm lhs + TermEither (Prelude.Left _) -> lambda "x" $ TypedTerm $ TermEither $ Prelude.Left $ Terms.var "x" + TermEither (Prelude.Right _) -> lambda "x" $ TypedTerm $ TermEither $ Prelude.Right $ Terms.var "x" + TermOptional (Just _) -> primitive (Prims.primName DefOptionals.pure) + TermInject (Injection tname (Field fname _)) -> lambda "x" $ inject tname fname $ var "x" + TermWrap (WrappedTerm tname _) -> lambda "x" $ wrap tname $ var "x" + +-- | Reify a binary Haskell-level meta-function over phantom-typed terms into a +-- first-class term-level function. See also 'reify' for the unary form. +-- Example: @reify2 (\\x y -> Maths.add x (Maths.mul x y))@ +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 + + + +-- | Create a 'Right' either value +-- Example: right (int32 42) +right :: TypedTerm b -> TypedTerm (Either a b) +right (TypedTerm term) = TypedTerm $ Terms.right term + +-- | Function that wraps a value in 'Right' +-- Example: right_ @@ myValue +right_ :: TypedTerm (b -> Either a b) +right_ = TypedTerm $ Terms.lambda "right_" $ Terms.right $ Terms.var "right_" + +-- | Create a set of terms +-- Example: set [string "a", string "b", string "c"] +set :: [TypedTerm a] -> TypedTerm (S.Set a) +set = TypedTerm . Terms.set . S.fromList . fmap unTypedTerm + +-- | Convert a typed binding to an untyped Binding for use in module element lists +-- Example: toBinding functionArity +toBinding :: TypedBinding a -> Binding +toBinding (TypedBinding name (TypedTerm term)) = Binding name term Nothing + +-- | Convert a phantom-typed term definition to a Definition for use in module definition lists +-- Example: toDefinition functionArity +toDefinition :: TypedTermDefinition a -> Definition +toDefinition (TypedTermDefinition name (TypedTerm term)) = DefinitionTerm $ TermDefinition name Nothing Nothing term + +-- | Define a primitive (no default implementation) within a module. +-- Analogous to 'definitionInModule' for term definitions. +-- Example: define = primitiveInModule module_ +primitiveInModule :: Module -> String -> String -> TermSignature -> [String] -> PrimitiveDefinition +primitiveInModule mod localName description sig comments = + PrimitiveDefinition + (unqualifyName (QualifiedName (Just (moduleName mod)) localName)) + (primitiveMetadata description comments) + sig True True Nothing + +-- | Define a primitive with a default implementation within a module. +-- Example: defineWithDefault = primitiveWithDefaultInModule module_ +primitiveWithDefaultInModule :: Module -> String -> String -> TermSignature -> [String] -> TypedTerm a -> PrimitiveDefinition +primitiveWithDefaultInModule mod localName description sig comments (TypedTerm impl) = + (primitiveInModule mod localName description sig comments) { primitiveDefinitionDefaultImplementation = Just impl } + +-- | Define an impure primitive (no default implementation) within a module. +-- Example: defineImpure = impurePrimitiveInModule module_ +impurePrimitiveInModule :: Module -> String -> String -> TermSignature -> [String] -> PrimitiveDefinition +impurePrimitiveInModule mod localName description sig comments = + (primitiveInModule mod localName description sig comments) { primitiveDefinitionIsPure = False } + +-- | Convert a TypeScheme to a TermSignature. Exported for use in primitive modules. +-- Example: sig $ TypeScheme [] (Types.boolean Types.~> Types.boolean) Nothing +sig :: TypeScheme -> TermSignature +sig = typeSchemeToTermSignature + +-- | Convert a TypeScheme to a TermSignature with lazy parameters at the given (0-based) positions. +-- Coders that distinguish strict from lazy evaluation thunk exactly these arguments. +-- Example: lazySig [1, 2] $ TypeScheme [Name "x"] (Types.boolean Types.~> ...) Nothing +lazySig :: [Int] -> TypeScheme -> TermSignature +lazySig idxs ts = markLazyParams idxs (sig ts) + +-- | Mark parameters at the given (0-based) positions as lazy in a TermSignature. +markLazyParams :: [Int] -> TermSignature -> TermSignature +markLazyParams idxs ts = ts { + termSignatureParameters = + zipWith (\i p -> if i `elem` idxs then p {parameterIsLazy = True} else p) + [0..] (termSignatureParameters ts)} + +-- | 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. +primitiveMetadata :: String -> [String] -> Maybe EntityMetadata +primitiveMetadata description comments = + Just (EntityMetadata (Just description) comments [] Nothing) + +-- | Convert a phantom-typed term definition to a primitive Definition, using the term body as the +-- declarative default implementation. +-- Example: toPrimitive "logical AND" andSig [] and_ +toPrimitive :: String -> TermSignature -> [String] -> TypedTermDefinition a -> Definition +toPrimitive description s comments (TypedTermDefinition name (TypedTerm term)) = + DefinitionPrimitive $ PrimitiveDefinition name (primitiveMetadata description comments) s True True (Just term) + +-- | Convert a Name to a primitive Definition with no default implementation. +-- Example: toPrimitiveNoDefault "Current UNIX time, in seconds" sig (Name "hydra.lib.math.currentUnixTimeSeconds") [] +toPrimitiveNoDefault :: String -> TermSignature -> Name -> [String] -> Definition +toPrimitiveNoDefault description s name comments = + DefinitionPrimitive $ PrimitiveDefinition name (primitiveMetadata description comments) s True True Nothing + +-- | Convert a Name to an impure primitive Definition. +toImpurePrimitive :: String -> TermSignature -> Name -> [String] -> Definition +toImpurePrimitive description s name comments = + DefinitionPrimitive $ PrimitiveDefinition name (primitiveMetadata description comments) s False True Nothing + +-- | Convert a typed binding to a term Definition for use in module definition lists +-- Example: toTermDefinition functionArity +toTermDefinition :: TypedBinding a -> Definition +toTermDefinition (TypedBinding name (TypedTerm term)) = DefinitionTerm $ TermDefinition name Nothing Nothing term + + +triple :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm (a, b, c) +triple (TypedTerm a) (TypedTerm b) (TypedTerm c) = TypedTerm $ Terms.triple a b c + +tuple4 :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d -> TypedTerm (a, b, c, d) +tuple4 (TypedTerm a) (TypedTerm b) (TypedTerm c) (TypedTerm d) = TypedTerm $ Terms.tuple4 a b c d + +tuple5 :: TypedTerm a -> TypedTerm b -> TypedTerm c -> TypedTerm d -> TypedTerm e -> TypedTerm (a, b, c, d, e) +tuple5 (TypedTerm a) (TypedTerm b) (TypedTerm c) (TypedTerm d) (TypedTerm e) = TypedTerm $ Terms.tuple5 a b c d e + +-- | Unit value (empty record) +unit :: TypedTerm a +unit = TypedTerm Terms.unit + +-- | Unsafe phantom type cast. Used during bootstrap when changing Module field types. +unsafeCast :: TypedTerm a -> TypedTerm b +unsafeCast (TypedTerm t) = TypedTerm t + +-- | Create an unwrap function for a wrapped type +-- Example: unwrap (Name "Email") +unwrap :: AsName n => n -> TypedTerm (a -> b) +unwrap = TypedTerm . Terms.unwrap . asName + +-- | Create a variable reference +-- Example: var "x" +var :: String -> TypedTerm a +var v = TypedTerm $ Terms.var v + +-- | Create a wrapped term (instance of a newtype) +-- Example: wrap (Name "Email") (string "user@example.com") +-- Note: the phantom types provide no guarantee of type safety in this case +wrap :: AsName n => n -> TypedTerm a -> TypedTerm b +wrap n (TypedTerm term) = TypedTerm $ Terms.wrap (asName n) term diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Tabular.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Tabular.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Tabular.hs @@ -0,0 +1,14 @@ +-- | DSL helpers for constructing tabular (relational) schemas + +module Hydra.Overlay.Haskell.Dsl.Typed.Tabular where + +import Hydra.Core +import Hydra.Relational +import Hydra.Tabular + + +columnType :: String -> Type -> ColumnType +columnType name typ = ColumnType (ColumnName name) typ + +tableType :: String -> [ColumnType] -> TableType +tableType name columns = TableType (RelationName name) columns diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Terms.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Terms.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Terms.hs @@ -0,0 +1,529 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | A domain-specific language for constructing term-encoded Hydra terms in Haskell; +-- these functions enable you to build terms (programs) which build terms. +module Hydra.Overlay.Haskell.Dsl.Typed.Terms ( + module Hydra.Overlay.Haskell.Dsl.Typed.Base, + module Hydra.Overlay.Haskell.Dsl.Typed.Terms, +) where + +import Hydra.Kernel +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Core as Core +import qualified Hydra.Encode.Core as EncodeCore +import Hydra.Overlay.Haskell.Dsl.Typed.Base +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Phantoms as Phantoms +import qualified Hydra.Dsl.Lib.Maps as Maps + +import qualified Data.ByteString as B +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Scientific as Sci +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Data.Int +import Prelude hiding (map, product, sum) + + +-- Operators + +-- | Function composition operator for term-encoded terms: f <.> g creates a function that applies g then f +-- Example: var "stringLength" <.> var "toString" +(<.>) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +f <.> g = compose f g + +-- | Function application operator for term-encoded terms +-- Example: fun @@ arg +(@@) :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +f @@ x = apply f x + +-- | Attach a map of annotations to a term-encoded term, wrapping the map as a +-- TermMap annotation per Hydra's convention (#386). Each Name key is lifted +-- to a TermVariable in the resulting TermMap. +-- Distinct from 'Phantoms.annot' (which attaches a single annotation by key). +-- Example: annots (Phantoms.map M.empty) (int32 42) +annots :: TypedTerm (M.Map Name Term) -> TypedTerm Term -> TypedTerm Term +annots annMap term = Core.termAnnotated $ Core.annotatedTerm term (annotationMapToTerm annMap) + +-- | Create a term-encoded annotated term (term with type annotations). +-- The map argument is wrapped as a TermMap annotation per Hydra's convention. +-- Example: annotated (int32 42) (Phantoms.map M.empty) +annotated :: TypedTerm Term -> TypedTerm (M.Map Name Term) -> TypedTerm Term +annotated term annMap = Core.termAnnotated $ Core.annotatedTerm term (annotationMapToTerm annMap) + +-- | Lift a term-encoded Map to a term-encoded TermMap with each +-- Name key wrapped as a TermVariable. The canonical encoding for Hydra's +-- annotation map convention after #386. +annotationMapToTerm :: TypedTerm (M.Map Name Term) -> TypedTerm Term +annotationMapToTerm m = Core.termMap + (Maps.mapKeys (Phantoms.lambda "n" (Core.termVariable (Phantoms.var "n"))) m) + +annotatedTerm :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +annotatedTerm body ann = inject (Core.nameLift _Term) "annotated" $ record (Core.nameLift _AnnotatedTerm) [ + _AnnotatedTerm_body>>: body, + _AnnotatedTerm_annotation>>: ann] + +-- | Apply a term-encoded function to a term-encoded argument +-- Example: apply (var "add") (int32 1) +apply :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +apply func arg = Core.termApplication $ Core.application func arg + +-- | Create a term-encoded unlimited precision integer +-- Example: bigint 42 +bigint :: Integer -> TypedTerm Term +bigint = bigintLift . TypedTerm . Terms.bigint + +-- | Lift a TypedTerm Integer to a term-encoded bigint literal +-- Example: bigintLift (varPhantom "x" :: TypedTerm Integer) +bigintLift :: TypedTerm Integer -> TypedTerm Term +bigintLift = Core.termLiteral . Core.literalInteger . Core.integerValueBigint + +-- | Create a term-encoded binary (byte string) literal +-- Example: binary (B.pack [0x48, 0x65, 0x6C, 0x6C, 0x6F]) +binary :: B.ByteString -> TypedTerm Term +binary = binaryLift . TypedTerm . Terms.binary + +-- | Lift a TypedTerm ByteString to a term-encoded binary literal +binaryLift :: TypedTerm B.ByteString -> TypedTerm Term +binaryLift = Core.termLiteral . Core.literalBinary + +-- | Create a term-encoded boolean literal +-- Example: boolean True +boolean :: Bool -> TypedTerm Term +boolean = booleanLift . TypedTerm . Terms.boolean + +-- | Lift a TypedTerm Bool to a term-encoded boolean literal +-- Example: booleanLift $ Phantoms.true +booleanLift :: TypedTerm Bool -> TypedTerm Term +booleanLift = Core.termLiteral . Core.literalBoolean + +-- | Create a meta-level term encoding a boolean literal +-- Example: booleanTerm True creates a term that *represents* the boolean True +booleanTerm :: Bool -> TypedTerm Term +booleanTerm b = inject (Core.nameLift _Term) "literal" $ inject (Core.nameLift _Literal) "boolean" $ boolean b + +-- | Create a term-encoded character literal via int32 +-- Example: char 'A' +char :: Char -> TypedTerm Term +char = int32 . ord + where + ord = fromEnum + +-- | Convert a Comparison enum value to a term-encoded term +-- Example: comparison ComparisonEqualTo +comparison :: Comparison -> TypedTerm Term +comparison t = case t of + ComparisonEqualTo -> Phantoms.injectUnit _Comparison _Comparison_equalTo + ComparisonLessThan -> Phantoms.injectUnit _Comparison _Comparison_lessThan + ComparisonGreaterThan -> Phantoms.injectUnit _Comparison _Comparison_greaterThan + + +-- | Term-encoded function composition (apply g then f) +-- Example: compose f g creates a function that applies g then f +compose :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +compose f g = lambda "arg_" $ f @@ (g @@ var "arg_") + +-- | Create a term-encoded constant function that always returns the same term-encoded value +-- Example: constant (int32 42) +constant :: TypedTerm Term -> TypedTerm Term +constant = lambda ignoredVariable + +-- | Create a term-encoded arbitrary-precision exact decimal literal +-- Example: decimal 42 +decimal :: Sci.Scientific -> TypedTerm Term +decimal = decimalLift . TypedTerm . Terms.decimal + +-- | Lift a TypedTerm Scientific to a term-encoded decimal literal +decimalLift :: TypedTerm Sci.Scientific -> TypedTerm Term +decimalLift = Core.termLiteral . Core.literalDecimal + +-- | Term-encoded boolean false literal +false :: TypedTerm Term +false = boolean False + +-- | Create a term-encoded field with the given name and term-encoded value +-- Example: field "age" (int32 30) +field :: String -> TypedTerm Term -> TypedTerm Field +field s = Core.field (name s) + +-- | Create a term-encoded floating-point literal with specified precision +-- Example: float (FloatValueFloat32 3.14) +float :: TypedTerm FloatValue -> TypedTerm Term +float = Core.termLiteral . Core.literalFloat + +-- | Create a term-encoded 32-bit floating point literal +-- Example: float32 3.14 +float32 :: Float -> TypedTerm Term +float32 = float32Lift . TypedTerm . Terms.float32 + +-- | Lift a TypedTerm Float to a term-encoded float32 literal +-- Example: float32Lift (varPhantom "x" :: TypedTerm Float) +float32Lift :: TypedTerm Float -> TypedTerm Term +float32Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat32 + +-- | Create a term-encoded 64-bit floating point literal +-- Example: float64 3.14159 +float64 :: Double -> TypedTerm Term +float64 = float64Lift . TypedTerm . Terms.float64 + +-- | Lift a TypedTerm Float to a term-encoded float64 literal +-- Example: float64Lift (varPhantom "x" :: TypedTerm Float) +float64Lift :: TypedTerm Double -> TypedTerm Term +float64Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat64 + +-- | Term-encoded identity function +-- Example: identity +identity :: TypedTerm Term +identity = lambda "x_" $ var "x_" + +-- | Create a term-encoded union injection +-- Example: inject (name "Result") "success" (int32 42) +inject :: AsTerm t Name => t -> String -> TypedTerm Term -> TypedTerm Term +inject tname fname = Core.termInject . Core.injection (asTerm tname) . Core.field (name fname) + +injectPhantom :: Name -> Name -> TypedTerm Term -> TypedTerm Term +injectPhantom tname fname term = Core.termInject $ Core.injection (Core.nameLift tname) $ Core.field (Core.nameLift fname) term + +injectUnit :: AsTerm t Name => t -> String -> TypedTerm Term +injectUnit tname fname = inject tname fname unit + +injectUnitPhantom :: Name -> Name -> TypedTerm Term +injectUnitPhantom tname fname = injectPhantom tname fname Core.termUnit + +-- | Create a term-encoded 16-bit signed integer literal +-- Example: int16 32767 +int16 :: Int16 -> TypedTerm Term +int16 = int16Lift . TypedTerm . Terms.int16 + +-- | Lift a TypedTerm Int16 to a term-encoded int16 literal +-- Example: int16Lift (varPhantom "x" :: TypedTerm Int16) +int16Lift :: TypedTerm Int16 -> TypedTerm Term +int16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt16 + +-- | Create a meta-level term encoding a 16-bit signed integer literal +-- Example: int16Term 100 creates a term that *represents* the int16 literal 100 +int16Term :: Int16 -> TypedTerm Term +int16Term n = inject (Core.nameLift _Term) "literal" $ + inject (Core.nameLift _Literal) "integer" $ + inject (Core.nameLift _IntegerValue) "int16" $ int16 n + +-- | Create a term-encoded 32-bit signed integer literal +-- Example: int32 42 +int32 :: Int -> TypedTerm Term +int32 = int32Lift . TypedTerm . Terms.int32 + +-- | Lift a TypedTerm Int to a term-encoded int32 literal +-- Example: int32Lift (varPhantom "x" :: TypedTerm Int) +int32Lift :: TypedTerm Int -> TypedTerm Term +int32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt32 + +-- | Create a meta-level term encoding a 32-bit signed integer literal +-- Example: int32Term 42 creates a term that *represents* the int32 literal 42 +int32Term :: Int -> TypedTerm Term +int32Term n = inject (Core.nameLift _Term) "literal" $ + inject (Core.nameLift _Literal) "integer" $ + inject (Core.nameLift _IntegerValue) "int32" $ int32 n + +-- | Create a term-encoded 64-bit signed integer literal +-- Example: int64 9223372036854775807 +int64 :: Int64 -> TypedTerm Term +int64 = int64Lift . TypedTerm . Terms.int64 + +-- | Lift a TypedTerm Int64 to a term-encoded int64 literal +-- Example: int64Lift (varPhantom "x" :: TypedTerm Int64) +int64Lift :: TypedTerm Int64 -> TypedTerm Term +int64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt64 + +-- | Create a meta-level term encoding a 64-bit signed integer literal +-- Example: int64Term 137 creates a term that *represents* the int64 literal 137 +int64Term :: Int64 -> TypedTerm Term +int64Term n = inject (Core.nameLift _Term) "literal" $ + inject (Core.nameLift _Literal) "integer" $ + inject (Core.nameLift _IntegerValue) "int64" $ int64 n + +-- | Create a term-encoded 8-bit signed integer literal +-- Example: int8 127 +int8 :: Int8 -> TypedTerm Term +int8 = int8Lift . TypedTerm . Terms.int8 + +-- | Lift a TypedTerm Int8 to a term-encoded int8 literal +-- Example: int8Lift (varPhantom "x" :: TypedTerm Int8) +int8Lift :: TypedTerm Int8 -> TypedTerm Term +int8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt8 + +-- | Create a term-encoded integer literal with specified bit width +-- Example: integer (IntegerValueInt32 42) +integer :: TypedTerm IntegerValue -> TypedTerm Term +integer = Core.termLiteral . Core.literalInteger + +-- | Create a term-encoded 'Just' optional value +-- Example: just (string "found") +just :: TypedTerm Term -> TypedTerm (Maybe Term) +just = Phantoms.just + +-- | Create a term-encoded lambda function with one parameter +-- Example: lambda "x" (var "add" @@ var "x" @@ int32 1) +lambda :: String -> TypedTerm Term -> TypedTerm Term +lambda var body = Core.termLambda $ Core.lambda (name var) Phantoms.nothing body + +-- | Create a term-encoded lambda with a type annotation +-- Example: lambdaTyped "x" T.int32 (var "x") +lambdaTyped :: String -> TypedTerm Type -> TypedTerm Term -> TypedTerm Term +lambdaTyped param dom body = Core.termLambda $ Core.lambda (name param) (Phantoms.just dom) body + +-- | Create a term-encoded multi-parameter lambda function (curried form) +-- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y") +lambdas :: [String] -> TypedTerm Term -> TypedTerm Term +lambdas params body = case params of + [] -> body + (h:rest) -> Core.termLambda $ Core.lambda (name h) Phantoms.nothing $ lambdas rest body + +-- | Create a term-encoded left either value +-- Example: left (string "error") +left :: TypedTerm Term -> TypedTerm Term +left t = Core.termEither $ Phantoms.left t + +-- | Create a term-encoded let expression with multiple bindings +-- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y") +lets :: [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term -> TypedTerm Term +lets pairs body = Core.termLet $ Core.let_ (Phantoms.list $ toBinding pairs) body + where + toBinding = fmap (\(n, t) -> Core.binding n t Phantoms.nothing) + +-- | Create a term-encoded let expression with type annotations on bindings +-- Example: letsTyped [("x", int32 1, T.mono T.int32)] (var "x") +letsTyped :: [(String, TypedTerm Term, TypedTerm TypeScheme)] -> TypedTerm Term -> TypedTerm Term +letsTyped bindings body = Core.termLet $ Core.let_ (Phantoms.list $ toBinding bindings) body + where + toBinding = fmap (\(n, t, ts) -> Core.binding (name n) t (Phantoms.just ts)) + +-- | Create a term-encoded list +-- Example: list [int32 1, int32 2, int32 3] +list :: [TypedTerm Term] -> TypedTerm Term +list = Core.termList . Phantoms.list + +-- | Create a term-encoded literal from a Literal value +-- Example: literal (LiteralInteger (IntegerValueInt32 42)) +literal :: TypedTerm Literal -> TypedTerm Term +literal = Core.termLiteral + +-- | Create a term-encoded map/dictionary +-- Example: map (fromList [(string "key", int32 42)]) +map :: TypedTerm (M.Map Term Term) -> TypedTerm Term +map = Core.termMap + +mapTerm1 :: TypedTerm (M.Map Term Term) -> TypedTerm Term +mapTerm1 m = inject (Core.nameLift _Term) "map" $ Core.termMap m + +-- | Create a term-encoded pattern match on a union +-- Example: match (name "Result") nothing ["success">: int32 42, "error">: string "fail"] +match :: AsTerm t Name => t -> TypedTerm (Maybe Term) -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term +match tname def pairs = Core.termCases + $ Core.caseStatement (asTerm tname) def $ Phantoms.list $ toCaseAlternative pairs + where + toCaseAlternative = fmap (\(n, t) -> Core.caseAlternative n t) + +--meta :: TypedTerm a -> TypedTerm Term +--meta (TypedTerm term) = TypedTerm $ EncodeCore.term term + +metaref :: TypedTermDefinition a -> TypedTerm Term +metaref (TypedTermDefinition name _) = Core.termVariable $ Core.nameLift name + +-- | Create a meta-level term encoding a Name +-- Example: nameTerm "foo" creates a term that *represents* the name "foo" +nameTerm :: String -> TypedTerm Term +nameTerm s = wrap (Core.nameLift _Name) $ string s + +-- | Create a term-encoded 'Nothing' optional value +nothing :: TypedTerm (Maybe Term) +nothing = Phantoms.nothing + +-- | Create a term-encoded optional value from a Maybe +-- Example: optional (just (int32 42)) +optional :: TypedTerm (Maybe Term) -> TypedTerm Term +optional = Core.termOptional + +-- | Create a term-encoded pair +-- Example: pair (string "name") (int32 42) +pair :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +pair t1 t2 = Core.termPair $ Phantoms.pair t1 t2 + +-- | Create a term-encoded reference to a primitive function. +-- Uses termVariable; the name resolves via graphPrimitives fallthrough. +-- Example: primitive DefStrings.length +primitive :: Terms.ToPrimName n => n -> TypedTerm Term +primitive = Core.termVariable . TypedTerm . EncodeCore.name . Terms.toPrimName + +-- | Create a term-encoded field projection function +-- Example: project (name "Person") (name "firstName") +project :: (AsTerm t Name, AsTerm f Name) => t -> f -> TypedTerm Term +project tname fname = Core.termProject + $ Core.projection (asTerm tname) (asTerm fname) + +-- | Create a term-encoded record with named fields +-- Example: record (name "Person") ["name">: string "John", "age">: int32 30] +record :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term +record name pairs = Core.termRecord $ Core.record (asTerm name) $ Phantoms.list (toField <$> pairs) + where + toField (n, t) = Core.field n t + +recordLift :: Name -> [(TypedTerm Name, TypedTerm Term)] -> TypedTerm Term +recordLift name pairs = record (TypedTerm $ EncodeCore.name name) pairs + +-- | Create a term-encoded right either value +-- Example: right (int32 42) +right :: TypedTerm Term -> TypedTerm Term +right t = Core.termEither $ Phantoms.right t + +-- | Create a term-encoded set +-- Example: set [string "a", string "b", string "c"] +set :: [TypedTerm Term] -> TypedTerm Term +set els = Core.termSet $ TypedTerm $ TermSet $ S.fromList (unTypedTerm <$> els) + +-- | Create a term-encoded string literal +-- Example: string "hello world" +string :: String -> TypedTerm Term +string = stringLift . TypedTerm . Terms.string + +-- | Lift a TypedTerm String to a term-encoded string literal +-- Example: stringLift $ Phantoms.string "hello world" +stringLift :: TypedTerm String -> TypedTerm Term +stringLift = Core.termLiteral . Core.literalString + +stringTerm :: String -> TypedTerm Term +stringTerm s = inject (Core.nameLift _Term) "literal" $ inject (Core.nameLift _Literal) "string" $ string s + +-- | Create a term-encoded 3-tuple using nested pairs +-- Example: triple (int32 1) (string "test") (boolean True) +triple :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term +triple t1 t2 t3 = pair t1 (pair t2 t3) + +-- | Term-encoded boolean true literal +true :: TypedTerm Term +true = boolean True + +-- | Create a term-encoded tuple with multiple components using nested pairs +-- Example: tuple [string "name", int32 42, boolean True] +tuple :: [TypedTerm Term] -> TypedTerm Term +tuple [] = unit +tuple [a] = a +tuple [a, b] = pair a b +tuple (a:rest) = pair a (tuple rest) + +-- | Create a term-encoded 2-tuple (same as pair) +-- Example: tuple2 (string "name") (int32 42) +tuple2 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term +tuple2 = pair + +-- | Create a term-encoded 4-tuple using nested pairs +-- Example: tuple4 (int32 1) (string "test") (boolean True) (float32 3.14) +tuple4 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term +tuple4 t1 t2 t3 t4 = pair t1 (pair t2 (pair t3 t4)) + +-- | Create a term-encoded 5-tuple using nested pairs +-- Example: tuple5 (int32 1) (string "a") (boolean True) (float32 3.14) (int32 42) +tuple5 :: TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term -> TypedTerm Term +tuple5 t1 t2 t3 t4 t5 = pair t1 (pair t2 (pair t3 (pair t4 t5))) + +-- | Create a term-encoded type application +-- Example: tyapp (list []) T.int32 +tyapp :: TypedTerm Term -> TypedTerm Type -> TypedTerm Term +tyapp term typ = Core.termTypeApplication $ Core.typeApplicationTerm term typ + +-- | Apply multiple type arguments to a term +-- Example: tyapps (pair (int32 1) (string "a")) [T.int32, T.string] +tyapps :: TypedTerm Term -> [TypedTerm Type] -> TypedTerm Term +tyapps = L.foldl tyapp + +-- | Create a term-encoded type lambda (System F) +-- Example: tylam "t0" (lambda "x" $ var "x") +tylam :: String -> TypedTerm Term -> TypedTerm Term +tylam var body = Core.termTypeLambda $ Core.typeLambda (name var) body + +-- | Create multiple term-encoded type lambdas +-- Example: tylams ["t0", "t1"] (lambda "x" $ var "x") +tylams :: [String] -> TypedTerm Term -> TypedTerm Term +tylams vars body = L.foldl (\b v -> Core.termTypeLambda $ Core.typeLambda (name v) b) body $ L.reverse vars + +-- | Apply type arguments to a polymorphic term (same as tyapps) +-- Example: typeApplication (list []) [T.int32] +typeApplication :: TypedTerm Term -> [TypedTerm Type] -> TypedTerm Term +typeApplication = tyapps + +-- | Create term-encoded type lambda(s) (same as tylams) +-- Example: typeLambda ["t0"] (lambda "x" $ var "x") +typeLambda :: [String] -> TypedTerm Term -> TypedTerm Term +typeLambda = tylams + +-- | Create a term-encoded 16-bit unsigned integer literal +-- Example: uint16 65535 +uint16 :: Int -> TypedTerm Term +uint16 = uint16Lift . TypedTerm . Terms.uint16 + +-- | Lift a TypedTerm Int to a term-encoded uint16 literal +-- Example: uint16Lift (varPhantom "x" :: TypedTerm Int) +uint16Lift :: TypedTerm Int -> TypedTerm Term +uint16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint16 + +-- | Create a term-encoded 32-bit unsigned integer literal +-- Example: uint32 4294967295 +uint32 :: Int64 -> TypedTerm Term +uint32 = uint32Lift . TypedTerm . Terms.uint32 + +-- | Lift a TypedTerm Int64 to a term-encoded uint32 literal +uint32Lift :: TypedTerm Int64 -> TypedTerm Term +uint32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint32 + +-- | Create a term-encoded 64-bit unsigned integer literal +-- Example: uint64 18446744073709551615 +uint64 :: Integer -> TypedTerm Term +uint64 = uint64Lift . TypedTerm . Terms.uint64 + +-- | Lift a TypedTerm Integer to a term-encoded uint64 literal +-- Example: uint64Lift (varPhantom "x" :: TypedTerm Integer) +uint64Lift :: TypedTerm Integer -> TypedTerm Term +uint64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint64 + +-- | Create a term-encoded 8-bit unsigned integer literal +-- Example: uint8 255 +uint8 :: Int16 -> TypedTerm Term +uint8 = uint8Lift . TypedTerm . Terms.uint8 + +uint8Lift :: TypedTerm Int16 -> TypedTerm Term +uint8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint8 + +-- | Create a term-encoded unit value +-- Example: unit +unit :: TypedTerm Term +unit = Core.termUnit + +-- | Create a term-encoded unwrap function for a wrapped type +-- Example: unwrap (name "Email") +unwrap :: AsTerm t Name => t -> TypedTerm Term +unwrap = Core.termUnwrap . asTerm + +-- | Create a term-encoded variable reference from a string +-- Example: var "x" +var :: String -> TypedTerm Term +var = Core.termVariable . name + +-- | Create a term-encoded variable reference from a Name +-- Example: varName (Name "x") +varName :: Name -> TypedTerm Term +varName (Name n) = Core.termVariable $ TypedTerm $ Terms.string n + +-- | Create a phantom-typed variable reference from a Name +-- Example: varNamePhantom (Name "x") :: TypedTerm Int +varNamePhantom :: Name -> TypedTerm a +varNamePhantom = TypedTerm . TermVariable + +-- | Maps a string to a phantom-typed variable term +-- Example: varPhantom "x" :: TypedTerm Int +varPhantom :: String -> TypedTerm a +varPhantom = TypedTerm . TermVariable . Name + +-- | Create a term-encoded wrapped term (newtype) +-- Example: wrap (name "Email") (string "user@example.com") +wrap :: AsTerm t Name => t -> TypedTerm Term -> TypedTerm Term +wrap n = Core.termWrap . Core.wrappedTerm (asTerm n) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Testing.hs @@ -0,0 +1,566 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Meta-DSL for constructing test-related terms +-- TODO: merge with Hydra.Dsl.Tests + +module Hydra.Overlay.Haskell.Dsl.Typed.Testing ( + module Hydra.Dsl.Testing, + module Hydra.Overlay.Haskell.Dsl.Typed.Testing, +) where + +import Hydra.Dsl.Testing hiding ( + effectfulTestCase, + tag, testCaseEffectful, testCaseUniversal, testCaseWithMetadata, + testCaseWithMetadataCase, testCaseWithMetadataDescription, + testCaseWithMetadataName, testCaseWithMetadataTags, testGroup, + universalTestCase, unTag) +import Hydra.Kernel +import Hydra.Error.Core (InvalidTermError) +import Hydra.Error.Packaging (InvalidModuleError, InvalidPackageError) +import Hydra.Testing as Testing +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms as Phantoms hiding ((++)) +import qualified Hydra.Dsl.Lib.Eithers as Eithers +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Pairs as Pairs +import qualified Hydra.Dsl.Lib.Strings as Strings +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 Hydra.Dsl.Validation as Validation + +import qualified Data.Int as I +import qualified Data.List as L +import qualified Data.Map as M + +type Int32 = I.Int32 + + +tag_disabled = Tag "disabled" +tag_disabledForMinimalInference = Tag "disabledForMinimalInference" + +alphaConvertRef :: TypedTerm (Name -> Name -> Term -> Term) +alphaConvertRef = TypedTerm $ TermVariable $ Name "hydra.reduction.alphaConvert" + +betaReduceTypeRef :: TypedTerm (InferenceContext -> Graph -> Type -> Either Error Type) +betaReduceTypeRef = TypedTerm $ TermVariable $ Name "hydra.reduction.betaReduceType" + +-- | Refs for hydra.validate.packaging validators and their show functions. +checkConflictingModuleNamesRef :: TypedTerm (Package -> Maybe InvalidPackageError) +checkConflictingModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkConflictingModuleNames" + +checkConflictingVariantNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkConflictingVariantNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkConflictingVariantNames" + +checkDefinitionDocumentationRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkDefinitionDocumentationRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionDocumentation" + +checkDefinitionModuleNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkDefinitionModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionModuleNames" + +checkDefinitionNameConventionRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkDefinitionNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionNameConvention" + +checkDefinitionOrderingRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkDefinitionOrderingRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDefinitionOrdering" + +checkDuplicateDefinitionNamesRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkDuplicateDefinitionNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDuplicateDefinitionNames" + +checkDuplicateModuleNamesRef :: TypedTerm (Package -> Maybe InvalidPackageError) +checkDuplicateModuleNamesRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkDuplicateModuleNames" + +checkModuleNameConventionRef :: TypedTerm (Module -> Maybe InvalidModuleError) +checkModuleNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkModuleNameConvention" + +checkPackageNameConventionRef :: TypedTerm (Package -> Maybe InvalidPackageError) +checkPackageNameConventionRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.checkPackageNameConvention" + +-- | 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) + (testCaseUniversal $ universalTestCase + (retype $ Eithers.either + (Phantoms.lambda "e" (Phantoms.string "<>")) + (Phantoms.lambda "result" + (showTypeRef @@ (typeSchemeToFTypeRef @@ Pairs.second (Pairs.first (Phantoms.var "result"))))) + (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ input)) + (retype $ showTypeRef @@ outputType)) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +evalCase :: String -> TypedTerm Term -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +evalCase cname input output = evalCaseWithTags cname [] input output + +-- | Create a universal test case that evaluates a Term via reduceTerm and compares the result. +evalCaseWithTags :: String -> [Tag] -> TypedTerm Term -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +evalCaseWithTags cname tags input output = testCaseWithMetadata (Phantoms.string cname) + (testCaseUniversal $ universalTestCase + (retype $ Eithers.either + (Phantoms.lambda "e" (Phantoms.string "<>")) + (Phantoms.lambda "t" (showTermRef @@ Phantoms.var "t")) + (reduceTermRef @@ testContextRef @@ testGraphRef @@ true @@ input)) + (retype $ showTermRef @@ output)) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Create a universal test case for an expression with a show function +evalPair :: String -> TypedTerm (t -> String) -> TypedTerm t -> TypedTerm t -> TypedTerm TestCaseWithMetadata +evalPair cname showFn logicalActual logicalExpected = universalCase cname + (retype $ showFn @@ logicalActual) (retype $ showFn @@ logicalExpected) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | evalPair with tags +evalPairWithTags :: String -> [Tag] -> TypedTerm (t -> String) -> TypedTerm t -> TypedTerm t -> TypedTerm TestCaseWithMetadata +evalPairWithTags cname tags showFn logicalActual logicalExpected = testCaseWithMetadata (Phantoms.string cname) + (testCaseUniversal $ universalTestCase (retype $ showFn @@ logicalActual) (retype $ showFn @@ logicalExpected)) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +expectFailure :: AsTerm t Term => Int -> [Tag] -> t -> TypedTerm TestCaseWithMetadata +expectFailure i tags term = infFailureTest ("#" ++ show i) tags (asTerm term) + +expectMono :: AsTerm t Term => Int -> [Tag] -> t -> TypedTerm Type -> TypedTerm TestCaseWithMetadata +expectMono i tags term typ = infTest ("#" ++ show i) tags (asTerm term) $ T.mono typ + +expectPoly :: AsTerm t Term => Int -> [Tag] -> t -> [String] -> TypedTerm Type -> TypedTerm TestCaseWithMetadata +expectPoly i tags term params typ = infTest ("#" ++ show i) tags (asTerm term) $ T.poly params typ + +expectPolyConstrained :: AsTerm t Term => Int -> [Tag] -> t -> [String] -> [(String, [String])] -> TypedTerm Type -> TypedTerm TestCaseWithMetadata +expectPolyConstrained i tags term params constraints typ = infTest ("#" ++ show i) tags (asTerm term) $ T.polyConstrained params constraints typ + +groupRef = MetaTerms.varNamePhantom . bindingName + +-- | Inference failure test: expects inference to fail. +infFailureTest :: String -> [Tag] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +infFailureTest name tags term = testCaseWithMetadata (Phantoms.string name) + (testCaseUniversal $ universalTestCase + (retype $ Eithers.either + (Phantoms.lambda "e" (Phantoms.string "FAIL")) + (Phantoms.lambda "result" (Strings.cat2 (Phantoms.string "unexpected: ") + (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result"))))) + (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) + (Phantoms.string "FAIL")) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Inference test: infer type and compare with expected type scheme. +infTest :: String -> [Tag] -> TypedTerm Term -> TypedTerm TypeScheme -> TypedTerm TestCaseWithMetadata +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 "result" + (showTypeSchemeRef @@ Pairs.second (Pairs.first (Phantoms.var "result")))) + (inferTypeOfRef @@ testContextRef @@ testGraphRef @@ term)) + (retype $ showTypeSchemeRef @@ ts)) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +isDisabled tcase = tag_disabled `L.elem` Testing.testCaseWithMetadataTags tcase +isDisabledForMinimalInference tcase = tag_disabledForMinimalInference `L.elem` Testing.testCaseWithMetadataTags tcase + +inferTypeOfRef :: TypedTerm (InferenceContext -> Graph -> Term -> Either Error ((Term, TypeScheme), InferenceContext)) +inferTypeOfRef = TypedTerm $ TermVariable $ Name "hydra.inference.inferTypeOf" + +-- | Reference to the kernel-default core validation profile (term + type +-- rules; 'singleVariantUnion' classified as a warning, everything else +-- as an error; maxErrors=1). +kernelDefaultCoreProfileRef :: TypedTerm ValidationProfile +kernelDefaultCoreProfileRef = TypedTerm $ TermVariable $ Name "hydra.validate.core.kernelDefaultCoreProfile" + +-- | Reference to the kernel-default packaging validation profile (every +-- per-module and per-package check classified as an error; maxErrors=1). +kernelDefaultPackagingProfileRef :: TypedTerm ValidationProfile +kernelDefaultPackagingProfileRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelDefaultPackagingProfile" + +-- | Reference to the kernel-strict 'kernelModule' convenience wrapper +-- (Maybe-returning, applies 'kernelDefaultPackagingProfile' internally). +-- Used by the kernelModule orchestrator tests in +-- 'Sources/Test/Validate/Packaging.hs'. +kernelModuleRef :: TypedTerm (Module -> Maybe InvalidModuleError) +kernelModuleRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelModule" + +-- | Reference to the kernel-strict 'kernelPackage' convenience wrapper. +kernelPackageRef :: TypedTerm (Package -> Maybe InvalidPackageError) +kernelPackageRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.kernelPackage" + +mapTerm :: [(TypedTerm Term, TypedTerm Term)] -> TypedTerm Term +mapTerm pairs = TypedTerm $ TermInject $ Injection _Term $ Field _Term_map $ TermMap $ M.fromList [(unTypedTerm k, unTypedTerm v) | (k, v) <- pairs] + +mapTermEmpty :: TypedTerm (M.Map k v) +mapTermEmpty = TypedTerm $ TermMap M.empty + +-- | Type checking test where term doesn't change (just check the inferred type) +noChange :: String -> TypedTerm Term -> TypedTerm Type -> TypedTerm TestCaseWithMetadata +noChange name term typ = checkTest name [] term term typ + +noTags :: TypedTerm [Tag] +noTags = Phantoms.list ([] :: [TypedTerm Tag]) + +primCase :: ToPrimName n => String -> n -> [TypedTerm Term] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +primCase cname prim args output = primCaseWithTags cname [] prim args output + +primCaseWithTags :: ToPrimName n => String -> [Tag] -> n -> [TypedTerm Term] -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +primCaseWithTags cname tags prim args output = evalCaseWithTags cname tags input output + where + input = L.foldl (MetaTerms.@@) (MetaTerms.primitive prim) args + +reduceTermRef :: TypedTerm (InferenceContext -> Graph -> Bool -> Term -> Either Error Term) +reduceTermRef = TypedTerm $ TermVariable $ Name "hydra.reduction.reduceTerm" + +removeTypesFromTermRef :: TypedTerm (Term -> Term) +removeTypesFromTermRef = TypedTerm $ TermVariable $ Name "hydra.strip.removeTypesFromTerm" + +showInvalidModuleErrorRef :: TypedTerm (InvalidModuleError -> String) +showInvalidModuleErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidModuleError" + +showInvalidPackageErrorRef :: TypedTerm (InvalidPackageError -> String) +showInvalidPackageErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.packaging.invalidPackageError" + +showInvalidTermErrorRef :: TypedTerm (InvalidTermError -> String) +showInvalidTermErrorRef = TypedTerm $ TermVariable $ Name "hydra.show.error.core.invalidTermError" + +showTermRef :: TypedTerm (Term -> String) +showTermRef = TypedTerm $ TermVariable $ Name "hydra.show.core.term" + +showTypeRef :: TypedTerm (Type -> String) +showTypeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.type" + +showTypeSchemeRef :: TypedTerm (TypeScheme -> String) +showTypeSchemeRef = TypedTerm $ TermVariable $ Name "hydra.show.core.typeScheme" + +-- | evalPair for String-typed expressions (identity show) +stringEvalPair :: String -> TypedTerm String -> TypedTerm String -> TypedTerm TestCaseWithMetadata +stringEvalPair cname = evalPair cname (Phantoms.lambda "s" (Phantoms.var "s")) + +subgroup :: AsTerm t TestCaseWithMetadata => String -> [t] -> TypedTerm TestGroup +subgroup name cases = tgroup name Nothing [] (asTerm <$> cases) + +supergroup :: AsTerm t TestGroup => String -> [t] -> TypedTerm TestGroup +supergroup name subgroups = tgroup name Nothing (asTerm <$> subgroups) [] + +tag :: String -> TypedTerm Tag +tag = Phantoms.wrap _Tag . Phantoms.string + +testContextRef :: TypedTerm InferenceContext +testContextRef = TypedTerm $ TermVariable $ Name "hydra.test.testGraph.testContext" + +-- | References to kernel functions (avoids circular imports) +testGraphRef :: TypedTerm Graph +testGraphRef = TypedTerm $ TermVariable $ Name "hydra.test.testGraph.testGraph" + +tgroup :: String -> Maybe String -> [TypedTerm TestGroup] -> [TypedTerm TestCaseWithMetadata] -> TypedTerm TestGroup +tgroup name mdesc subgroups cases = testGroup (Phantoms.string name) (opt (Phantoms.string <$> mdesc)) (Phantoms.list subgroups) (Phantoms.list cases) + +typeSchemeToFTypeRef :: TypedTerm (TypeScheme -> Type) +typeSchemeToFTypeRef = TypedTerm $ TermVariable $ Name "hydra.scoping.typeSchemeToFType" + +universalCase :: String -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata +universalCase cname actual expected = testCaseWithMetadata (Phantoms.string cname) + (testCaseUniversal $ universalTestCase (retype actual) (retype expected)) + nothing noTags + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Create an effectful test case: 'actual' is an effect-typed term that the test runner +-- interprets (within a per-case empty temporary directory) to a result string; 'expected' is a +-- string-typed term. As with universalCase, both are passed bare and codegen wraps them as the +-- unit-thunk fields of EffectfulTestCase. +effectfulCase :: String -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata +effectfulCase cname actual expected = effectfulCaseWithTags cname [] actual expected + +effectfulCaseWithTags :: String -> [Tag] -> TypedTerm a -> TypedTerm b -> TypedTerm TestCaseWithMetadata +effectfulCaseWithTags cname tags actual expected = testCaseWithMetadata (Phantoms.string cname) + (testCaseEffectful $ effectfulTestCase (retype actual) (retype expected)) + nothing (Phantoms.list $ tag . unTag <$> tags) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Reference to the profile-aware core term validator. Used by +-- 'validateCoreTermCase' (with 'kernelDefaultCoreProfileRef'-applied, +-- head-extracted to preserve the legacy 'Maybe E' shape) and by +-- 'validateCoreTermCaseWithProfile' (with an explicit profile). +validateCoreTermProfiledRef :: TypedTerm (ValidationProfile -> Bool -> Graph -> Term -> ValidationResult InvalidTermError) +validateCoreTermProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.core.term" + +-- | Reference to the profile-aware packaging module validator. Used by +-- 'validatePackagingModuleCaseWithProfile' directly. +validatePackagingModuleProfiledRef :: TypedTerm (ValidationProfile -> ValidationResult InvalidModuleError -> Module -> ValidationResult InvalidModuleError) +validatePackagingModuleProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.module" + +-- | Reference to the profile-aware packaging package validator. Returns a +-- 'ValidationResult InvalidPackageError'; used by +-- 'validatePackagingPackageCaseWithProfile'. +validatePackagingPackageProfiledRef :: TypedTerm (ValidationProfile -> ValidationResult InvalidPackageError -> Package -> ValidationResult InvalidPackageError) +validatePackagingPackageProfiledRef = TypedTerm $ TermVariable $ Name "hydra.validate.packaging.package" + +---------------------------------------- + +-- | Convenience function for creating alpha conversion test cases +alphaCase :: String -> TypedTerm Term -> TypedTerm Name -> TypedTerm Name -> TypedTerm Term -> TypedTerm TestCaseWithMetadata +alphaCase cname term oldVar newVar result = universalCase cname + (retype $ showTermRef @@ (alphaConvertRef @@ oldVar @@ newVar @@ term)) + (retype $ showTermRef @@ result) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +encodedTestGroupToBinding :: ModuleName -> String -> TypedTerm TestGroup -> Binding +encodedTestGroupToBinding ns lname group = Binding name (unTypedTerm group) + $ Just $ TypeScheme [] typ Nothing + where + name = unqualifyName $ QualifiedName (Just ns) lname + typ = TypeVariable _TestGroup + +-- | Render a 'ValidationResult InvalidModuleError' as a string of the form +-- "errors=[s1;s2] warnings=[w1]". Counterpart of 'showValidationResultTerm' +-- 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 ";") $ + 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 ";") $ + Lists.map (Phantoms.lambda "w" $ showInvalidModuleErrorRef @@ Phantoms.var "w") + (Validation.validationResultWarnings vr)) + (Phantoms.string "]")) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Render a 'ValidationResult InvalidPackageError' as a string. Package-level +-- 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 ";") $ + 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 ";") $ + Lists.map (Phantoms.lambda "w" $ showInvalidPackageErrorRef @@ Phantoms.var "w") + (Validation.validationResultWarnings vr)) + (Phantoms.string "]")) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Profile-aware variant of 'validatePackagingModuleCase'. Calls +-- 'hydra.validate.packaging.module'' (the new orchestrator) starting from +-- an empty 'ValidationResult' and compares the full result shape against +-- the expected. +validatePackagingModuleCaseWithProfile + :: String + -> TypedTerm ValidationProfile + -> TypedTerm Module + -> TypedTerm (ValidationResult InvalidModuleError) + -> TypedTerm TestCaseWithMetadata +validatePackagingModuleCaseWithProfile cname profile input expected = universalCase cname + (showValidationResultModule + (validatePackagingModuleProfiledRef @@ profile @@ emptyResultModule @@ input)) + (showValidationResultModule expected) + where + emptyResultModule :: TypedTerm (ValidationResult InvalidModuleError) + emptyResultModule = Validation.validationResult + (Phantoms.list ([] :: [TypedTerm InvalidModuleError])) + (Phantoms.list ([] :: [TypedTerm InvalidModuleError])) + +-- | Profile-aware variant of 'validatePackagingPackageCase'. +validatePackagingPackageCaseWithProfile + :: String + -> TypedTerm ValidationProfile + -> TypedTerm Package + -> TypedTerm (ValidationResult InvalidPackageError) + -> TypedTerm TestCaseWithMetadata +validatePackagingPackageCaseWithProfile cname profile input expected = universalCase cname + (showValidationResultPackage + (validatePackagingPackageProfiledRef @@ profile @@ emptyResultPackage @@ input)) + (showValidationResultPackage expected) + where + emptyResultPackage :: TypedTerm (ValidationResult InvalidPackageError) + emptyResultPackage = Validation.validationResult + (Phantoms.list ([] :: [TypedTerm InvalidPackageError])) + (Phantoms.list ([] :: [TypedTerm InvalidPackageError])) + +-- | Render a 'ValidationResult InvalidTermError' as a string of the form +-- "errors=[s1;s2] warnings=[w1]". Used to compare actual vs expected +-- '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 ";") $ + 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 ";") $ + Lists.map (Phantoms.lambda "w" $ showInvalidTermErrorRef @@ Phantoms.var "w") + (Validation.validationResultWarnings vr)) + (Phantoms.string "]")) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Profile-aware variant of 'validateCoreTermCase'. Compares the full +-- 'ValidationResult' shape — both errors and warnings — against the +-- expected, allowing the caller to specify any profile (not just the +-- kernel default). Use for tests that exercise multi-error +-- accumulation, warning vs error classification, or rule disabling. +validateCoreTermCaseWithProfile + :: String + -> TypedTerm ValidationProfile + -> TypedTerm Bool + -> TypedTerm Term + -> TypedTerm (ValidationResult InvalidTermError) + -> TypedTerm TestCaseWithMetadata +validateCoreTermCaseWithProfile cname profile typed input expected = universalCase cname + (showValidationResultTerm + (validateCoreTermProfiledRef @@ profile @@ typed @@ testGraphRef @@ input)) + (showValidationResultTerm expected) + +testCaseEffectful :: TypedTerm EffectfulTestCase -> TypedTerm TestCase +testCaseEffectful = inject _TestCase _TestCase_effectful + +testCaseUniversal :: TypedTerm UniversalTestCase -> TypedTerm TestCase +testCaseUniversal = inject _TestCase _TestCase_universal + +testCaseWithMetadata :: TypedTerm String -> TypedTerm TestCase -> TypedTerm (Maybe String) -> TypedTerm [Tag] -> TypedTerm TestCaseWithMetadata +testCaseWithMetadata name tcase description tags = Phantoms.record _TestCaseWithMetadata [ + _TestCaseWithMetadata_name>>: name, + _TestCaseWithMetadata_case>>: tcase, + _TestCaseWithMetadata_description>>: description, + _TestCaseWithMetadata_tags>>: tags] + +testCaseWithMetadataCase :: TypedTerm (TestCaseWithMetadata -> TestCase) +testCaseWithMetadataCase = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_case + +testCaseWithMetadataDescription :: TypedTerm (TestCaseWithMetadata -> Maybe String) +testCaseWithMetadataDescription = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_description + +testCaseWithMetadataName :: TypedTerm (TestCaseWithMetadata -> String) +testCaseWithMetadataName = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_name + +testCaseWithMetadataTags :: TypedTerm (TestCaseWithMetadata -> [Tag]) +testCaseWithMetadataTags = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_tags + +testGroup :: TypedTerm String -> TypedTerm (Maybe String) -> TypedTerm [TestGroup] -> TypedTerm [TestCaseWithMetadata] -> TypedTerm TestGroup +testGroup name description subgroups cases = Phantoms.record _TestGroup [ + _TestGroup_name>>: name, + _TestGroup_description>>: description, + _TestGroup_subgroups>>: subgroups, + _TestGroup_cases>>: cases] + +-- | Convenience function for creating type reduction test cases +typeRedCase :: String -> TypedTerm Type -> TypedTerm Type -> TypedTerm TestCaseWithMetadata +typeRedCase cname input output = universalCase cname + (retype $ Eithers.either + (Phantoms.lambda "e" (Phantoms.string "<>")) + (Phantoms.lambda "t" (showTypeRef @@ Phantoms.var "t")) + (betaReduceTypeRef @@ testContextRef @@ testGraphRef @@ input)) + (retype $ showTypeRef @@ output) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Build a 'UniversalTestCase' from two string-producing expressions. +-- Each expression is wrapped in a unit-lambda so its evaluation is deferred +-- until the runner forces the thunk inside its per-test timing bracket. See +-- issue #311: without thunking, eagerly-evaluated hosts (Scala, the four +-- complete Lisps) compute 'actual'/'expected' at test-data load time, before +-- any timer starts, and report zero elapsed time. +universalTestCase :: TypedTerm String -> TypedTerm String -> TypedTerm UniversalTestCase +universalTestCase actual expected = Phantoms.record _UniversalTestCase [ + _UniversalTestCase_actual Phantoms.>>: thunk actual, + _UniversalTestCase_expected Phantoms.>>: thunk expected] + where + thunk :: TypedTerm String -> TypedTerm (() -> String) + thunk body = Phantoms.lambda "_" body + +-- | Build an EffectfulTestCase from a bare effect term (the action) and a bare string term +-- (the expected value); both are wrapped as unit-thunk fields, mirroring universalTestCase. +effectfulTestCase :: TypedTerm String -> TypedTerm String -> TypedTerm EffectfulTestCase +effectfulTestCase actual expected = Phantoms.record _EffectfulTestCase [ + _EffectfulTestCase_actual Phantoms.>>: thunk actual, + _EffectfulTestCase_expected Phantoms.>>: thunk expected] + where + thunk :: TypedTerm String -> TypedTerm (() -> String) + thunk body = Phantoms.lambda "_" body + +-- | Convenience function for creating validation test cases. Drives the +-- profile-aware 'hydra.validate.core.term' with the kernel-default core +-- profile and head-extracts the resulting errors list — preserving the +-- legacy 'Maybe InvalidTermError' shape that existing test data uses. +-- Tests that need to assert multi-error accumulation, warning +-- classification, or rule disabling should use +-- 'validateCoreTermCaseWithProfile' instead. +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 $ + validateCoreTermProfiledRef @@ kernelDefaultCoreProfileRef @@ typed @@ testGraphRef @@ input) + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidTermErrorRef @@ Phantoms.var "e"))) + (retype $ Optionals.cases + expected + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidTermErrorRef @@ Phantoms.var "e"))) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Convenience function for creating module-validation test cases. +-- Applies a packaging-level Module validator to an input module and compares +-- the result against the expected Maybe InvalidModuleError. +validatePackagingModuleCase :: String -> TypedTerm (Module -> Maybe InvalidModuleError) -> TypedTerm Module -> TypedTerm (Maybe InvalidModuleError) -> TypedTerm TestCaseWithMetadata +validatePackagingModuleCase cname validator input expected = universalCase cname + (retype $ Optionals.cases + (validator @@ input) + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidModuleErrorRef @@ Phantoms.var "e"))) + (retype $ Optionals.cases + expected + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidModuleErrorRef @@ Phantoms.var "e"))) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t + +-- | Convenience function for creating package-validation test cases. +-- Applies a packaging-level Package validator to an input package and compares +-- the result against the expected Maybe InvalidPackageError. +validatePackagingPackageCase :: String -> TypedTerm (Package -> Maybe InvalidPackageError) -> TypedTerm Package -> TypedTerm (Maybe InvalidPackageError) -> TypedTerm TestCaseWithMetadata +validatePackagingPackageCase cname validator input expected = universalCase cname + (retype $ Optionals.cases + (validator @@ input) + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidPackageErrorRef @@ Phantoms.var "e"))) + (retype $ Optionals.cases + expected + (Phantoms.string "valid") + (Phantoms.lambda "e" (showInvalidPackageErrorRef @@ Phantoms.var "e"))) + where + retype :: TypedTerm x -> TypedTerm String + retype (TypedTerm t) = TypedTerm t diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Types.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Types.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Types.hs @@ -0,0 +1,299 @@ +-- | A domain-specific language for constructing term-encoded Hydra types in Haskell; +-- these functions enable you to build terms (programs) which build types. + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Hydra.Overlay.Haskell.Dsl.Typed.Types ( + module Hydra.Overlay.Haskell.Dsl.Typed.Base, + module Hydra.Overlay.Haskell.Dsl.Typed.Types, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.AsTerm +import qualified Hydra.Overlay.Haskell.Dsl.Typed.Phantoms as Phantoms +import qualified Hydra.Dsl.Lib.Maps as Maps +import Hydra.Overlay.Haskell.Dsl.Typed.Core as Core hiding (name, unName) +import Hydra.Overlay.Haskell.Dsl.Typed.Base + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Maybe as Y +import qualified Data.Set as S +import Prelude hiding (either, map, maybe, product, sum) + + +-- Operators + +-- | Type application operator +-- Example: typeConstructor @@ typeArg +(@@) :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +(@@) = apply + +-- | Function type constructor operator +-- Example: int32 --> string +(-->) :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +(-->) = function + + +-- | Attach an annotation map to a term-encoded type, wrapping the map as a +-- TermMap annotation per Hydra's convention (#386). Each Name key is lifted +-- to a TermVariable. +-- Example: annot annotationMap myType +annot :: TypedTerm (M.Map Name Term) -> TypedTerm Type -> TypedTerm Type +annot ann typ = typeAnnotated $ annotatedType typ + (Core.termMap (Maps.mapKeys (Phantoms.lambda "n" (Core.termVariable (Phantoms.var "n"))) ann)) + +-- | Apply a term-encoded type to a type argument +-- Example: apply (var "Maybe") int32 +apply :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +apply l r = typeApplication $ applicationType l r + +applys :: TypedTerm Type -> [TypedTerm Type] -> TypedTerm Type +applys t ts = L.foldl apply t ts + +-- | Create a term-encoded arbitrary-precision integer type +-- Example: bigint +bigint :: TypedTerm Type +bigint = typeLiteral $ literalTypeInteger integerTypeBigint + +-- | Create a term-encoded binary type +-- Example: binary +binary :: TypedTerm Type +binary = typeLiteral literalTypeBinary + +-- | Create a term-encoded boolean type +-- Example: boolean +boolean :: TypedTerm Type +boolean = typeLiteral literalTypeBoolean + +-- | Create a term-encoded arbitrary-precision decimal type +-- Example: decimal +decimal :: TypedTerm Type +decimal = typeLiteral literalTypeDecimal + +-- | Create a term-encoded either type +-- Example: either_ string int32 +either_ :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +either_ l r = typeEither $ eitherType l r + +-- | Create a term-encoded enum type with the given variant names (conventionally in camelCase) +-- Example: enum (name "Color") ["red", "green", "blue"] +-- Accepts TypedTerm Name or TypedBinding Name (via AsTerm) +enum :: AsTerm t Name => t -> [String] -> TypedTerm Type +enum tname names = union tname $ (\n -> (name n, unit)) <$> names + +-- | Create a term-encoded field with the given name and type +-- Example: field "age" int32 +field :: String -> TypedTerm Type -> TypedTerm FieldType +field s = fieldType (name s) + +-- | Create a term-encoded FloatType representation +-- Example: float FloatTypeFloat64 +float :: FloatType -> TypedTerm FloatType +float t = Phantoms.injectUnit _FloatType $ case t of + FloatTypeFloat32 -> _FloatType_float32 + FloatTypeFloat64 -> _FloatType_float64 + +-- | Create a term-encoded 32-bit floating point type +-- Example: float32 +float32 :: TypedTerm Type +float32 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat32 + +-- | Create a term-encoded 64-bit floating point type +-- Example: float64 +float64 :: TypedTerm Type +float64 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat64 + +-- | Create a term-encoded universal quantification (polymorphic type) +-- Example: forAll "a" (var "a" --> var "a") +forAll :: String -> TypedTerm Type -> TypedTerm Type +forAll var body = typeForall $ forallType (name var) body + +forAlls :: [String] -> TypedTerm Type -> TypedTerm Type +forAlls vs body = L.foldr forAll body vs + +-- | Create a term-encoded function type +-- Example: function int32 string +function :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +function dom cod = typeFunction $ functionType dom cod + +-- | Create a term-encoded multi-parameter function type +-- Example: functionMany [int32, string, boolean] +functionMany :: [TypedTerm Type] -> TypedTerm Type +functionMany types = case types of + [t] -> t + t:ts -> function t $ functionMany ts + +-- | Create a term-encoded 16-bit signed integer type +-- Example: int16 +int16 :: TypedTerm Type +int16 = typeLiteral $ literalTypeInteger integerTypeInt16 + +-- | Create a term-encoded 32-bit signed integer type +-- Example: int32 +int32 :: TypedTerm Type +int32 = typeLiteral $ literalTypeInteger integerTypeInt32 + +-- | Create a term-encoded 64-bit signed integer type +-- Example: int64 +int64 :: TypedTerm Type +int64 = typeLiteral $ literalTypeInteger integerTypeInt64 + +-- | Create a term-encoded 8-bit signed integer type +-- Example: int8 +int8 :: TypedTerm Type +int8 = typeLiteral $ literalTypeInteger integerTypeInt8 + +-- | Create a term-encoded IntegerType representation +-- Example: integer IntegerTypeInt32 +integer :: IntegerType -> TypedTerm IntegerType +integer t = Phantoms.injectUnit _IntegerType $ case t of + IntegerTypeBigint -> _IntegerType_bigint + IntegerTypeInt8 -> _IntegerType_int8 + IntegerTypeInt16 -> _IntegerType_int16 + IntegerTypeInt32 -> _IntegerType_int32 + IntegerTypeInt64 -> _IntegerType_int64 + IntegerTypeUint8 -> _IntegerType_uint8 + IntegerTypeUint16 -> _IntegerType_uint16 + IntegerTypeUint32 -> _IntegerType_uint32 + IntegerTypeUint64 -> _IntegerType_uint64 + +-- | Create a term-encoded list type +-- Example: list string +list :: TypedTerm Type -> TypedTerm Type +list = typeList + +-- | Create a term-encoded literal type from a LiteralType value +-- Example: literal (literalTypeInteger integerTypeInt32) +literal :: TypedTerm LiteralType -> TypedTerm Type +literal = typeLiteral + +-- | Create a term-encoded map/dictionary type +-- Example: map string int32 +map :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +map k v = typeMap $ mapType k v + +-- | Create a term-encoded monomorphic type scheme +-- Example: mono int32 +mono :: TypedTerm Type -> TypedTerm TypeScheme +mono t = Phantoms.record _TypeScheme [ + Phantoms.field _TypeScheme_variables $ Phantoms.list ([] :: [TypedTerm Name]), + Phantoms.field _TypeScheme_body t, + Phantoms.field _TypeScheme_constraints Phantoms.nothing] + +-- | Term-encoded non-negative 32-bit integer type +-- Currently an alias for int32; intended for semantic annotation +-- In future versions, this may include validation constraints +-- Example: nonNegativeInt32 +nonNegativeInt32 :: TypedTerm Type +nonNegativeInt32 = Hydra.Overlay.Haskell.Dsl.Typed.Types.int32 + +-- | Create a term-encoded optional (nullable) type +-- Example: optional string +optional :: TypedTerm Type -> TypedTerm Type +optional = typeOptional + +-- | Create a term-encoded pair type +-- Example: pair string int32 +pair :: TypedTerm Type -> TypedTerm Type -> TypedTerm Type +pair first second = Core.typePair $ Core.pairType first second + +-- | Create a term-encoded polymorphic type scheme +-- Example: poly ["a", "b"] (var "a" --> var "b") +poly :: [String] -> TypedTerm Type -> TypedTerm TypeScheme +poly params t = Phantoms.record _TypeScheme [ + Phantoms.field _TypeScheme_variables (Phantoms.list (name <$> params)), + Phantoms.field _TypeScheme_body t, + Phantoms.field _TypeScheme_constraints Phantoms.nothing] + +-- | Create a term-encoded polymorphic type scheme with class constraints +-- Example: polyConstrained ["k", "v"] [("k", ["ordering"])] (map (var "k") (var "v")) +polyConstrained :: [String] -> [(String, [String])] -> TypedTerm Type -> TypedTerm TypeScheme +polyConstrained params constraints t = Phantoms.record _TypeScheme [ + Phantoms.field _TypeScheme_variables (Phantoms.list (name <$> params)), + Phantoms.field _TypeScheme_body t, + Phantoms.field _TypeScheme_constraints constraintsTerm] + where + constraintsTerm = Phantoms.just $ Phantoms.map $ M.fromList + [(name v, Core.typeVariableConstraints (Phantoms.list (Core.typeClassConstraintSimple . name <$> classes))) + | (v, classes) <- constraints] + +-- | Create a term-encoded product type (tuple) with multiple components using nested pairs +-- Example: product [string, int32, boolean] +product :: [TypedTerm Type] -> TypedTerm Type +product [] = unit +product [a] = a +product [a, b] = pair a b +product (a:rest) = pair a (product rest) + +-- | Create a term-encoded record type with named fields +-- Example: record (name "Person") ["name">: string, "age">: int32] +-- Note: the name parameter is now ignored; record types no longer carry a type name +record :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Type)] -> TypedTerm Type +record _n pairs = typeRecord $ Phantoms.list (toField <$> pairs) + where + toField (fn, t) = fieldType fn t + +-- | Create a term-encoded set type +-- Example: set string +set :: TypedTerm Type -> TypedTerm Type +set = typeSet + +-- | Create a term-encoded string type +-- Example: string +string :: TypedTerm Type +string = typeLiteral literalTypeString + +-- | Create a term-encoded 16-bit unsigned integer type +-- Example: uint16 +uint16 :: TypedTerm Type +uint16 = typeLiteral $ literalTypeInteger integerTypeUint16 + +-- | Create a term-encoded 32-bit unsigned integer type +-- Example: uint32 +uint32 :: TypedTerm Type +uint32 = typeLiteral $ literalTypeInteger integerTypeUint32 + +-- | Create a term-encoded 64-bit unsigned integer type +-- Example: uint64 +uint64 :: TypedTerm Type +uint64 = typeLiteral $ literalTypeInteger integerTypeUint64 + +-- | Create a term-encoded 8-bit unsigned integer type +-- Example: uint8 +uint8 :: TypedTerm Type +uint8 = typeLiteral $ literalTypeInteger integerTypeUint8 + +-- | Create a term-encoded union type with named variants +-- Example: union (name "Result") ["success">: int32, "error">: string] +-- Note: the name parameter is now ignored; union types no longer carry a type name +union :: AsTerm t Name => t -> [(TypedTerm Name, TypedTerm Type)] -> TypedTerm Type +union _n pairs = typeUnion $ Phantoms.list (toField <$> pairs) + where + toField (fn, ft) = fieldType fn ft + +-- | Term-encoded unit type (empty record type) +-- Example: unit +unit :: TypedTerm Type +unit = typeUnit + +-- | Create a term-encoded type variable (alias for 'variable') +-- Example: var "a" +var :: String -> TypedTerm Type +var = variable + +-- | Create a term-encoded type variable +-- Example: variable "a" +variable :: String -> TypedTerm Type +variable = typeVariable . name + +-- | Term-encoded void type (uninhabited / bottom type) +-- Example: void +void :: TypedTerm Type +void = typeVoid + +-- | Create a term-encoded wrapped type (newtype) +-- Note: the name parameter is now ignored; wrapped types no longer carry a type name +wrap :: AsTerm t Name => t -> TypedTerm Type -> TypedTerm Type +wrap _n t = typeWrap t diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Variants.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Variants.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Typed/Variants.hs @@ -0,0 +1,68 @@ +-- | Haskell-specific convenience layer over the generated Hydra.Dsl.Variants module. +-- Adds Haskell enum -> TypedTerm converter functions. + +module Hydra.Overlay.Haskell.Dsl.Typed.Variants ( + module Hydra.Dsl.Variants, + module Hydra.Overlay.Haskell.Dsl.Typed.Variants, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.Dsl.Typed.Phantoms +import Hydra.Dsl.Variants + + +-- | Convert a Haskell LiteralVariant to a TypedTerm +literalVariant :: LiteralVariant -> TypedTerm LiteralVariant +literalVariant v = injectUnit _LiteralVariant $ case v of + LiteralVariantBinary -> _LiteralVariant_binary + LiteralVariantBoolean -> _LiteralVariant_boolean + LiteralVariantDecimal -> _LiteralVariant_decimal + LiteralVariantFloat -> _LiteralVariant_float + LiteralVariantInteger -> _LiteralVariant_integer + LiteralVariantString -> _LiteralVariant_string + +-- | Convert a Haskell TermVariant to a TypedTerm +termVariant :: TermVariant -> TypedTerm TermVariant +termVariant v = injectUnit _TermVariant $ case v of + TermVariantAnnotated -> _TermVariant_annotated + TermVariantApplication -> _TermVariant_application + TermVariantCases -> _TermVariant_cases + TermVariantEither -> _TermVariant_either + TermVariantLambda -> _TermVariant_lambda + TermVariantLet -> _TermVariant_let + TermVariantList -> _TermVariant_list + TermVariantLiteral -> _TermVariant_literal + TermVariantMap -> _TermVariant_map + TermVariantOptional -> _TermVariant_optional + TermVariantPair -> _TermVariant_pair + TermVariantProject -> _TermVariant_project + TermVariantRecord -> _TermVariant_record + TermVariantSet -> _TermVariant_set + TermVariantTypeLambda -> _TermVariant_typeLambda + TermVariantTypeApplication -> _TermVariant_typeApplication + TermVariantInject -> _TermVariant_inject + TermVariantUnit -> _TermVariant_unit + TermVariantUnwrap -> _TermVariant_unwrap + TermVariantVariable -> _TermVariant_variable + TermVariantWrap -> _TermVariant_wrap + +-- | Convert a Haskell TypeVariant to a TypedTerm +typeVariant :: TypeVariant -> TypedTerm TypeVariant +typeVariant v = injectUnit _TypeVariant $ case v of + TypeVariantAnnotated -> _TypeVariant_annotated + TypeVariantApplication -> _TypeVariant_application + TypeVariantEither -> _TypeVariant_either + TypeVariantFunction -> _TypeVariant_function + TypeVariantForall -> _TypeVariant_forall + TypeVariantList -> _TypeVariant_list + TypeVariantLiteral -> _TypeVariant_literal + TypeVariantMap -> _TypeVariant_map + TypeVariantOptional -> _TypeVariant_optional + TypeVariantPair -> _TypeVariant_pair + TypeVariantRecord -> _TypeVariant_record + TypeVariantSet -> _TypeVariant_set + TypeVariantUnion -> _TypeVariant_union + TypeVariantUnit -> _TypeVariant_unit + TypeVariantVariable -> _TypeVariant_variable + TypeVariantVoid -> _TypeVariant_void + TypeVariantWrap -> _TypeVariant_wrap diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Types.hs b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Types.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Dsl/Types.hs @@ -0,0 +1,271 @@ +-- | A domain-specific language for constructing Hydra types in Haskell. +module Hydra.Overlay.Haskell.Dsl.Types where + +import Prelude hiding (product) + +import Hydra.Core +import Hydra.Overlay.Haskell.AsType +import Hydra.Overlay.Haskell.Dsl.Typed.Common +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S + + +-- Operators + +-- | Function type constructor with infix syntax +-- Example: int32 ~> string +-- Use this for more readable function type definitions +infixr 0 ~> +(~>) :: (AsType a, AsType b) => a -> b -> Type +dom ~> cod = function (asType dom) (asType cod) + +-- | Function type constructor with infix syntax (deprecated, use ~> instead) +-- Example: int32 --> string +infixr 0 --> +(-->) :: (AsType a, AsType b) => a -> b -> Type +dom --> cod = function (asType dom) (asType cod) + +-- | Type application operator +-- Example: list @@ int32 +(@@) :: (AsType a, AsType b) => a -> b -> Type +fun @@ arg = apply (asType fun) (asType arg) + +-- | Field definition operator +-- Example: "name">: string +infixr 0 >: +(>:) :: AsType a => String -> a -> FieldType +name>: typ = field name (asType typ) + + +-- | Attach an annotation map to a type, wrapping the map as a TermMap per +-- Hydra's convention (#386 — annotation is now a Term, not a Map). +-- Example: annot (M.fromList [(Name "min", int32 0), (Name "max", int32 100)]) int32 +annot :: AsType a => M.Map Name Term -> a -> Type +annot ann typ = TypeAnnotated $ AnnotatedType (asType typ) (Terms.annotationMapAsTerm ann) + +-- | Apply a type to a type argument +-- Example: apply (var "f") int32 +apply :: (AsType a, AsType b) => a -> b -> Type +apply lhs rhs = TypeApplication (ApplicationType (asType lhs) (asType rhs)) + +-- | Apply a type to multiple type arguments +-- Example: applys (var "Either") [string, int32] +applys :: AsType a => a -> [Type] -> Type +applys t ts = L.foldl apply (asType t) ts + +-- | Arbitrary-precision integer type +bigint :: Type +bigint = integer IntegerTypeBigint + +-- | Binary data type +binary :: Type +binary = literal LiteralTypeBinary + +-- | Boolean type +boolean :: Type +boolean = literal LiteralTypeBoolean + +-- | Arbitrary-precision decimal type +decimal :: Type +decimal = literal LiteralTypeDecimal + +-- | Create an either type (a choice between two types) +-- Example: either_ string int32 +either_ :: (AsType a, AsType b) => a -> b -> Type +either_ left right = TypeEither $ EitherType (asType left) (asType right) + +-- | Create an effect type (a computation producing a value of the given type) +-- Example: effect (either_ fileError string) +effect :: AsType a => a -> Type +effect = TypeEffect . asType + +-- | Create an enum type with the given variant names (conventionally in camelCase) +-- Example: enum ["red", "green", "blue"] +enum :: [String] -> Type +enum names = union $ (`field` unit) <$> names + +-- | Create a field with the given name and type +-- Example: field "age" int32 +field :: AsType a => String -> a -> FieldType +field fn t = FieldType (Name fn) (asType t) + +-- | Create a floating point type with the specified precision +-- Example: float FloatTypeFloat32 +float :: FloatType -> Type +float = literal . LiteralTypeFloat + +-- | 32-bit floating point type +float32 :: Type +float32 = float FloatTypeFloat32 + +-- | 64-bit floating point type +float64 :: Type +float64 = float FloatTypeFloat64 + +-- | Create a universally quantified type (polymorphic type) with a singe variable +-- Example: forAll "a" (var "a" --> var "a") +-- This creates the polymorphic identity function type: ∀a. a -> a +-- Universal quantification introduces type variables that can be used in the body +forAll :: AsType a => String -> a -> Type +forAll v body = TypeForall $ ForallType (Name v) (asType body) + +-- | Universal quantification with multiple variables +-- Example: forAlls ["a", "b"] (var "a" --> var "b") +forAlls :: AsType a => [String] -> a -> Type +forAlls vs body = L.foldr forAll (asType body) vs + +-- | Create a function type +-- Example: function int32 string +function :: (AsType a, AsType b) => a -> b -> Type +function dom cod = TypeFunction $ FunctionType (asType dom) (asType cod) + +-- | Create an n-ary function type +-- Example: functionMany [int32, string, boolean] +functionMany :: [Type] -> Type +functionMany ts = L.foldl (\cod dom -> function dom cod) (L.head r) (L.tail r) + where + r = L.reverse ts + +-- | 16-bit signed integer type +int16 :: Type +int16 = integer IntegerTypeInt16 + +-- | 32-bit signed integer type +int32 :: Type +int32 = integer IntegerTypeInt32 + +-- | 64-bit signed integer type +int64 :: Type +int64 = integer IntegerTypeInt64 + +-- | 8-bit signed integer type +int8 :: Type +int8 = integer IntegerTypeInt8 + +-- | Create an integer type with the specified bit width +-- Example: integer IntegerTypeInt32 +integer :: IntegerType -> Type +integer = literal . LiteralTypeInteger + +-- | List type +-- Example: list string +list :: AsType a => a -> Type +list = TypeList . asType + +-- | Literal primitive type +-- Example: literal LiteralTypeString +literal :: LiteralType -> Type +literal = TypeLiteral + +-- | Map/dictionary type with key and value types +-- Example: map string int32 +map :: (AsType a, AsType b) => a -> b -> Type +map keys vals = TypeMap $ MapType (asType keys) (asType vals) + +-- | Create a monomorphic type scheme +-- Example: mono int32 +mono :: AsType a => a -> TypeScheme +mono t = TypeScheme [] (asType t) Nothing + +-- | Non-negative 32-bit integer type +-- Currently an alias for int32; intended for semantic annotation +-- In future versions, this may include validation constraints +nonNegativeInt32 :: Type +nonNegativeInt32 = int32 + +-- | Optional (nullable) type +-- Example: optional string +optional :: AsType a => a -> Type +optional = TypeOptional . asType + +-- | Create a pair type +-- Example: pair string int32 +pair :: (AsType a, AsType b) => a -> b -> Type +pair first second = TypePair $ PairType (asType first) (asType second) + +-- | Create a polymorphic type scheme with explicit type variables +-- Example: poly ["a", "b"] (var "a" --> var "b") +-- This represents a type forall a b. a -> b that can be instantiated with different types +poly :: AsType a => [String] -> a -> TypeScheme +poly vs t = TypeScheme (Name <$> vs) (asType t) Nothing + +-- | Create a polymorphic type scheme with explicit type variables and constraints +-- Example: polyConstrained [("a", [Name "hydra.core.Eq"])] (var "a" --> var "a" --> boolean) +-- This represents a type forall a. (Eq a) => a -> a -> Boolean +polyConstrained :: AsType a => [(String, [Name])] -> a -> TypeScheme +polyConstrained vsWithConstraints t = TypeScheme vars (asType t) (Just constraintMap) + where + vars = Name . fst <$> vsWithConstraints + constraintMap = M.fromList + [(Name v, TypeVariableConstraints (TypeClassConstraintSimple <$> classes)) | (v, classes) <- vsWithConstraints, not (L.null classes)] + +-- | Create a product type using nested pairs (deprecated: use pair directly) +-- Example: product [string, int32, boolean] creates pair string (pair int32 boolean) +product :: [Type] -> Type +product [] = unit +product [a] = a +product [a, b] = pair a b +product (a:rest) = pair a (product rest) + +-- | Create a record type with the given fields +-- Example: record ["name">: string, "age">: int32] +record :: [FieldType] -> Type +record = TypeRecord + +-- | Set type +-- Example: set string +set :: AsType a => a -> Type +set = TypeSet . asType + +-- | String type +string :: Type +string = literal LiteralTypeString + +-- | 16-bit unsigned integer type +uint16 :: Type +uint16 = integer IntegerTypeUint16 + +-- | 32-bit unsigned integer type +uint32 :: Type +uint32 = integer IntegerTypeUint32 + +-- | 64-bit unsigned integer type +uint64 :: Type +uint64 = integer IntegerTypeUint64 + +-- | 8-bit unsigned integer type +uint8 :: Type +uint8 = integer IntegerTypeUint8 + +-- | Create a union type with the given variants +-- Example: union ["success">: int32, "failure">: string] +-- This creates a tagged union type (sum type with named variants) +-- Similar to sum [int32, string] but with named branches +union :: [FieldType] -> Type +union = TypeUnion + +-- | Unit type (empty record type) +unit :: Type +unit = TypeUnit + +-- | Create a type variable with the given name (alias for 'variable') +-- Example: var "a" +var :: String -> Type +var = variable + +-- | Create a type variable with the given name +-- Example: variable "a" +variable :: String -> Type +variable = TypeVariable . Name + +-- | Void type (uninhabited / bottom type) +void :: Type +void = TypeVoid + +-- | Create a wrapped type (newtype) with a provided base type +-- Example: wrap string +wrap :: AsType a => a -> Type +wrap = TypeWrap . asType diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Chars.hs @@ -0,0 +1,31 @@ +-- | Haskell implementations of hydra.lib.chars primitives. +-- All functions operate on Unicode code points (Int) rather than Char. + +module Hydra.Overlay.Haskell.Lib.Chars where + +import qualified Data.Char as C + + +-- | Check whether a character is alphanumeric. +isAlphaNum :: Int -> Bool +isAlphaNum = C.isAlphaNum . C.chr + +-- | Check whether a character is lowercase. +isLower :: Int -> Bool +isLower = C.isLower . C.chr + +-- | Check whether a character is a whitespace character. +isSpace :: Int -> Bool +isSpace = C.isSpace . C.chr + +-- | Check whether a character is uppercase. +isUpper :: Int -> Bool +isUpper = C.isUpper . C.chr + +-- | Convert a character to lowercase. +toLower :: Int -> Int +toLower = C.ord . C.toLower . C.chr + +-- | Convert a character to uppercase. +toUpper :: Int -> Int +toUpper = C.ord . C.toUpper . C.chr diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Effects.hs @@ -0,0 +1,40 @@ +-- | Haskell implementations of hydra.lib.effects primitives + +module Hydra.Overlay.Haskell.Lib.Effects where + +import qualified Control.Monad as CM +import Prelude hiding (foldl, map, pure) +import qualified Prelude as P + + +-- | Applicative apply for effects. +apply :: IO (a -> b) -> IO a -> IO b +apply = (P.<*>) + +-- | Sequence two effectful computations. +bind :: IO a -> (a -> IO b) -> IO b +bind = (P.>>=) + +-- | Kleisli composition for effects. +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. +foldl :: (a -> b -> IO a) -> a -> [b] -> IO a +foldl = CM.foldM + +-- | Map a pure function over the result of an effect. +map :: (a -> b) -> IO a -> IO b +map = P.fmap + +-- | Map an effect-returning function over a list. +mapList :: (a -> IO b) -> [a] -> IO [b] +mapList = CM.mapM + +-- | Map an effect-returning function over an optional. +mapOptional :: (a -> IO b) -> Maybe a -> IO (Maybe b) +mapOptional = CM.mapM + +-- | Lift a pure value into an effect. +pure :: a -> IO a +pure = P.pure diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Eithers.hs @@ -0,0 +1,69 @@ +-- | Haskell implementations of hydra.lib.eithers primitives + +module Hydra.Overlay.Haskell.Lib.Eithers where + +import qualified Control.Monad as CM +import qualified Data.Bifunctor as BF +import qualified Data.Either as E +import qualified Data.Set as S + + +-- | Map over both sides of an Either value. +bimap :: (a -> c) -> (b -> d) -> Either a b -> Either c d +bimap = BF.bimap + +-- | Bind (flatMap) for Either: if Right, apply the function; if Left, return unchanged. +bind :: Either a b -> (b -> Either a c) -> Either a c +bind = (>>=) + +-- | 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 + +-- | Check if an Either is a Left value. +isLeft :: Either a b -> Bool +isLeft = E.isLeft + +-- | Check if an Either is a Right value. +isRight :: Either a b -> Bool +isRight = E.isRight + +-- | Extract all Left values from a list of Eithers. +lefts :: [Either a b] -> [a] +lefts = E.lefts + +-- | Map a function over the Right side of an Either (standard functor map). +map :: (a -> b) -> Either c a -> Either c b +map = fmap + +-- | Map a function returning Either over a list, collecting results or short-circuiting on Left. +mapList :: (a -> Either c b) -> [a] -> Either c [b] +mapList = CM.mapM + +-- | Map a function returning Either over an optional, or return Right Nothing if Nothing. +mapOptional :: (a -> Either c b) -> Maybe a -> Either c (Maybe b) +mapOptional = CM.mapM + +-- | Map a function returning Either over a Set, collecting results or short-circuiting on Left. +mapSet :: Ord b => (a -> Either c b) -> S.Set a -> Either c (S.Set b) +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 + +-- | Extract all Right values from a list of Eithers. +rights :: [Either a b] -> [b] +rights = E.rights diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Equality.hs @@ -0,0 +1,47 @@ +-- | Haskell implementations of hydra.lib.equality primitives. + +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 diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Files.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Files.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Files.hs @@ -0,0 +1,115 @@ +-- | Haskell implementations of hydra.lib.files primitives + +module Hydra.Overlay.Haskell.Lib.Files where + +import qualified Control.Exception as E +import qualified Data.ByteString as BS +import qualified Hydra.Error.File as FileError +import qualified Hydra.File as File +import qualified Hydra.Time as Time +import qualified System.Directory as Dir +import qualified System.IO.Error as IOE +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Prelude hiding (appendFile, readFile, writeFile) + + +appendFile :: File.FilePath -> BS.ByteString -> IO (Either FileError.FileError ()) +appendFile path contents = + withFileError path $ BS.appendFile (File.unFilePath path) contents + +copy :: Bool -> File.FilePath -> File.FilePath -> IO (Either FileError.FileError ()) +copy recursive source destination = + withFileError source $ + if recursive + then copyDirectoryRecursive (File.unFilePath source) (File.unFilePath destination) + else Dir.copyFile (File.unFilePath source) (File.unFilePath destination) + +createDirectory :: Bool -> File.FilePath -> IO (Either FileError.FileError ()) +createDirectory recursive path = + withFileError path $ + if recursive + then Dir.createDirectoryIfMissing True (File.unFilePath path) + else Dir.createDirectory (File.unFilePath path) + +exists :: File.FilePath -> IO (Either FileError.FileError Bool) +exists path = + withFileError path $ Dir.doesPathExist (File.unFilePath path) + +listDirectory :: File.FilePath -> IO (Either FileError.FileError [File.FilePath]) +listDirectory path = + withFileError path $ + fmap (fmap File.FilePath) (Dir.listDirectory (File.unFilePath path)) + +readFile :: File.FilePath -> IO (Either FileError.FileError BS.ByteString) +readFile path = + withFileError path $ BS.readFile (File.unFilePath path) + +removeDirectory :: Bool -> File.FilePath -> IO (Either FileError.FileError ()) +removeDirectory recursive path = + withFileError path $ + if recursive + then Dir.removeDirectoryRecursive (File.unFilePath path) + else Dir.removeDirectory (File.unFilePath path) + +removeFile :: File.FilePath -> IO (Either FileError.FileError ()) +removeFile path = + withFileError path $ Dir.removeFile (File.unFilePath path) + +rename :: File.FilePath -> File.FilePath -> IO (Either FileError.FileError ()) +rename source destination = + withFileError source $ Dir.renamePath (File.unFilePath source) (File.unFilePath destination) + +status :: File.FilePath -> IO (Either FileError.FileError File.FileStatus) +status path = + withFileError path $ do + let p = File.unFilePath path + isDir <- Dir.doesDirectoryExist p + size <- Dir.getFileSize p + mtime <- Dir.getModificationTime p + pure File.FileStatus { + File.fileStatusFileType = if isDir then File.FileTypeDirectory else File.FileTypeRegular, + File.fileStatusSize = fromInteger size, + File.fileStatusModificationTime = utcToTimespec mtime, + File.fileStatusAccessTime = Nothing, + File.fileStatusStatusChangeTime = Nothing} + +writeFile :: File.FilePath -> BS.ByteString -> IO (Either FileError.FileError ()) +writeFile path contents = + withFileError path $ BS.writeFile (File.unFilePath path) contents + +-- Helpers (not primitives) + +withFileError :: File.FilePath -> IO a -> IO (Either FileError.FileError a) +withFileError path action = + E.catch (Right <$> action) $ \e -> + pure $ Left $ classify path (e :: IOError) + +classify :: File.FilePath -> IOError -> FileError.FileError +classify path e + | IOE.isAlreadyExistsError e = FileError.FileErrorAlreadyExists path + | IOE.isDoesNotExistError e = FileError.FileErrorNotFound path + | IOE.isPermissionError e = FileError.FileErrorPermissionDenied path + | IOE.isIllegalOperation e = FileError.FileErrorInvalidPath (IOE.ioeGetErrorString e) + | otherwise = FileError.FileErrorOther (IOE.ioeGetErrorString e) + +-- | Convert a UTCTime to a hydra.time.Timespec (seconds + nanoseconds since the Unix Epoch). +utcToTimespec :: UTCTime -> Time.Timespec +utcToTimespec t = + let picos = floor (toRational (utcTimeToPOSIXSeconds t) * 1000000000000) :: Integer + (secs, subPicos) = picos `divMod` 1000000000000 + nanos = subPicos `div` 1000 + in Time.Timespec { + Time.timespecSeconds = fromInteger secs, + Time.timespecNanoseconds = fromInteger nanos} + +-- | Recursively copy a directory tree from source to destination. +copyDirectoryRecursive :: FilePath -> FilePath -> IO () +copyDirectoryRecursive source destination = do + isDir <- Dir.doesDirectoryExist source + if isDir + then do + Dir.createDirectoryIfMissing True destination + entries <- Dir.listDirectory source + mapM_ (\name -> copyDirectoryRecursive (source ++ "/" ++ name) (destination ++ "/" ++ name)) entries + else Dir.copyFile source destination diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Lists.hs @@ -0,0 +1,171 @@ +-- | Haskell implementations of hydra.lib.lists primitives + +module Hydra.Overlay.Haskell.Lib.Lists where + +import Hydra.Util +import Hydra.Core +import Hydra.Graph +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms + +import qualified Data.List as L + + +-- | Apply a list of functions to a list of values (applicative style). +apply :: [a -> b] -> [a] -> [b] +apply = (<*>) + +-- | Apply a function that returns lists to each element and flatten results. +bind :: [a] -> (a -> [b]) -> [b] +bind = (>>=) + +-- | Concatenate a list of lists. +concat :: [[a]] -> [a] +concat = L.concat + +-- | Concatenate two lists. +concat2 :: [a] -> [a] -> [a] +concat2 l1 l2 = l1 ++ l2 + +-- | Prepend a value to a list. +cons :: a -> [a] -> [a] +cons = (:) + +-- | Drop the first n elements from a list. +drop :: Int -> [a] -> [a] +drop = L.drop + +-- | Drop elements from the beginning of a list while predicate is true. +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 + +-- | Find the first element matching a predicate. +find :: (a -> Bool) -> [a] -> Maybe a +find = L.find + +-- | 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 +-- Hydra.Python.Coder.extendMetaForTerm), causing pathological wallclock +-- in the Python coder's gatherMetadata pass. Use foldl' to evaluate +-- each accumulator step strictly. +foldl :: (b -> a -> b) -> b -> [a] -> b +foldl = L.foldl' + +-- | Fold a list from the right. +foldr :: (a -> b -> b) -> b -> [a] -> b +foldr = L.foldr + +-- | Group consecutive equal elements. +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 + +-- | Intersperse a value between elements of a list. +intersperse :: a -> [a] -> [a] +intersperse = L.intersperse + +-- | Get the length of a list. +length :: [a] -> Int +length = L.length + +-- | Map a function over a list. +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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | Remove duplicate elements from a list. +nub :: Eq a => [a] -> [a] +nub = L.nub + +-- | Check if a list is empty. +null :: [a] -> Bool +null = L.null + +-- | Partition a list into elements that satisfy a predicate and elements that do not. +partition :: (a -> Bool) -> [a] -> ([a], [a]) +partition = L.partition + +-- | Create a list with a single element. +pure :: a -> [a] +pure e = [e] + +-- | Create a list with n copies of a value. +replicate :: Int -> a -> [a] +replicate = L.replicate + +-- | Reverse a list. +reverse :: [a] -> [a] +reverse = L.reverse + +-- | Create a single-element list. +singleton :: a -> [a] +singleton e = [e] + +-- | Sort a list. +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 + +-- | Split a list at the first element where predicate fails. +span :: (a -> Bool) -> [a] -> ([a], [a]) +span = L.span + +-- | Take the first n elements from a list. +take :: Int -> [a] -> [a] +take = L.take + +-- | Transpose a list of lists. +transpose :: [[a]] -> [[a]] +transpose = L.transpose + +-- | Decompose a list into its head and tail, returning Nothing if the list is empty. +uncons :: [a] -> Maybe (a, [a]) +uncons [] = Nothing +uncons (x:xs) = Just (x, xs) + +-- | Zip two lists into pairs. +zip :: [a] -> [b] -> [(a, b)] +zip = L.zip + +-- | Zip two lists with a combining function. +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWith = L.zipWith diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Literals.hs @@ -0,0 +1,273 @@ +-- | Haskell implementations of hydra.lib.literals primitives + +module Hydra.Overlay.Haskell.Lib.Literals where + +import Data.Int +import Data.Scientific (Scientific, toRealFloat, fromFloatDigits) +import Text.Read (readMaybe) +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as B64 +import qualified Data.Scientific as Sci +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +-- | Convert a bigint (Integer) to a decimal (Scientific). +bigintToDecimal :: Integer -> Scientific +bigintToDecimal n = Sci.scientific n 0 + +-- | Convert a bigint (Integer) to an int8. +bigintToInt8 :: Integer -> Int8 +bigintToInt8 = fromIntegral + +-- | Convert a bigint (Integer) to an int16. +bigintToInt16 :: Integer -> Int16 +bigintToInt16 = fromIntegral + +-- | Convert a bigint (Integer) to an int32. +bigintToInt32 :: Integer -> Int +bigintToInt32 = fromIntegral + +-- | Convert a bigint (Integer) to an int64. +bigintToInt64 :: Integer -> Int64 +bigintToInt64 = fromIntegral + +-- | Convert a bigint (Integer) to a uint8. +bigintToUint8 :: Integer -> Int16 +bigintToUint8 = fromIntegral + +-- | Convert a bigint (Integer) to a uint16. +bigintToUint16 :: Integer -> Int +bigintToUint16 = fromIntegral + +-- | Convert a bigint (Integer) to a uint32. +bigintToUint32 :: Integer -> Int64 +bigintToUint32 = fromIntegral + +-- | Convert a bigint (Integer) to a uint64. +bigintToUint64 :: Integer -> Integer +bigintToUint64 = id + +-- | Convert binary to a list of byte values (0-255). +binaryToBytes :: B.ByteString -> [Int] +binaryToBytes = fmap fromIntegral . B.unpack + +-- | Convert a decimal (Scientific) to a bigint (Integer) using banker's rounding +-- (round half to even), matching Haskell's 'round' and the BigDecimal/BigInt behavior +-- in the other Hydra hosts. +decimalToBigint :: Scientific -> Integer +decimalToBigint = round + +-- | Convert a decimal (Scientific) to a float32 (Float). May lose precision. +decimalToFloat32 :: Scientific -> Float +decimalToFloat32 = toRealFloat + +-- | Convert a decimal (Scientific) to a float64 (Double). May lose precision. +decimalToFloat64 :: Scientific -> Double +decimalToFloat64 = toRealFloat + +-- | Convert binary to string by base64 encoding. +binaryToString :: B.ByteString -> String +binaryToString = T.unpack . TE.decodeUtf8 . B64.encode + +-- | Convert a float32 (Float) to a decimal (Scientific). +float32ToDecimal :: Float -> Scientific +float32ToDecimal = fromFloatDigits + +-- | Convert a float32 (Float) to a float64 (Double). +-- Preserves IEEE special values (NaN, +/-Infinity); plain realToFrac +-- routes through Rational and collapses Inf to maxFinite (~3.4028e38). +float32ToFloat64 :: Float -> Double +float32ToFloat64 x + | isNaN x = 0/0 + | isInfinite x = if x < 0 then -1/0 else 1/0 + | otherwise = realToFrac x + +-- | Convert a float64 (Double) to a decimal (Scientific). +float64ToDecimal :: Double -> Scientific +float64ToDecimal = fromFloatDigits + +-- | Convert a float64 (Double) to a float32 (Float). May lose precision. +-- IEEE special values are preserved; for finite values, realToFrac +-- (which converts via Rational) is used. +float64ToFloat32 :: Double -> Float +float64ToFloat32 x + | isNaN x = 0/0 + | isInfinite x = if x < 0 then -1/0 else 1/0 + | otherwise = realToFrac x + +-- | Convert an int8 to a bigint (Integer). +int8ToBigint :: Int8 -> Integer +int8ToBigint = fromIntegral + +-- | Convert an int16 to a bigint (Integer). +int16ToBigint :: Int16 -> Integer +int16ToBigint = fromIntegral + +-- | Convert an int32 to a bigint (Integer). +int32ToBigint :: Int -> Integer +int32ToBigint = fromIntegral + +-- | Convert an int64 to a bigint (Integer). +int64ToBigint :: Int64 -> Integer +int64ToBigint = fromIntegral + +-- | Parse a string to a bigint (Integer). +readBigint :: String -> Maybe Integer +readBigint s = readMaybe s :: Maybe Integer + +-- | Parse a string to a boolean. +readBoolean :: String -> Maybe Bool +readBoolean s = if s == "true" then Just True + else if s == "false" then Just False + else Nothing + +-- | Parse a string to a decimal (Scientific). +readDecimal :: String -> Maybe Scientific +readDecimal s = readMaybe s :: Maybe Scientific + +-- | Parse a string to a float32 (Float). +readFloat32 :: String -> Maybe Float +readFloat32 s = readMaybe s :: Maybe Float + +-- | Parse a string to a float64 (Double). +readFloat64 :: String -> Maybe Double +readFloat64 s = readMaybe s :: Maybe Double + +-- | Parse a string to an int8 (-128 to 127). +readInt8 :: String -> Maybe Int8 +readInt8 s = do + n <- readMaybe s :: Maybe Integer + if n >= -128 && n <= 127 then Just (fromIntegral n) else Nothing + +-- | Parse a string to an int16 (-32768 to 32767). +readInt16 :: String -> Maybe Int16 +readInt16 s = do + n <- readMaybe s :: Maybe Integer + if n >= -32768 && n <= 32767 then Just (fromIntegral n) else Nothing + +-- | Parse a string to an int32. +readInt32 :: String -> Maybe Int +readInt32 s = readMaybe s :: Maybe Int + +-- | Parse a string to an int64. +readInt64 :: String -> Maybe Int64 +readInt64 s = readMaybe s :: Maybe Int64 + +-- | Parse a string literal. +readString :: String -> Maybe String +readString 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 +-- The read functions parse as unsigned and validate the range + +-- | Parse a string to a uint8 (0 to 255). +readUint8 :: String -> Maybe Int16 +readUint8 s = do + n <- readMaybe s :: Maybe Integer + if n >= 0 && n <= 255 then Just (fromIntegral n) else Nothing + +-- | Parse a string to a uint16 (0 to 65535). +readUint16 :: String -> Maybe Int +readUint16 s = do + n <- readMaybe s :: Maybe Integer + if n >= 0 && n <= 65535 then Just (fromIntegral n) else Nothing + +-- | Parse a string to a uint32 (0 to 4294967295). +readUint32 :: String -> Maybe Int64 +readUint32 s = do + n <- readMaybe s :: Maybe Integer + if n >= 0 && n <= 4294967295 then Just (fromIntegral n) else Nothing + +-- | Parse a string to a uint64 (0 to 18446744073709551615). +readUint64 :: String -> Maybe Integer +readUint64 s = do + n <- readMaybe s :: Maybe Integer + if n >= 0 && n <= 18446744073709551615 then Just n else Nothing + +-- | Convert a bigint (Integer) to string. +showBigint :: Integer -> String +showBigint = show + +-- | Convert a boolean to string. +showBoolean :: Bool -> String +showBoolean b = case b of + True -> "true" + False -> "false" + +-- | Convert a decimal (Scientific) to string. Uses Scientific's default format +-- (regular notation for small-magnitude values; scientific notation for very +-- large or very small). +showDecimal :: Scientific -> String +showDecimal = show + +-- | Convert a float32 (Float) to string. +showFloat32 :: Float -> String +showFloat32 = show + +-- | Convert a float64 (Double) to string. +showFloat64 :: Double -> String +showFloat64 = show + +-- | Convert an int8 to string. +showInt8 :: Int8 -> String +showInt8 = show + +-- | Convert an int16 to string. +showInt16 :: Int16 -> String +showInt16 = show + +-- | Convert an int32 to string. +showInt32 :: Int -> String +showInt32 = show + +-- | Convert an int64 to string. +showInt64 :: Int64 -> String +showInt64 = show + +-- | Convert a string to a quoted string representation. +showString :: String -> String +showString = show + +-- | Convert a uint8 to string. +showUint8 :: Int16 -> String +showUint8 = show + +-- | Convert a uint16 to string. +showUint16 :: Int -> String +showUint16 = show + +-- | Convert a uint32 to string. +showUint32 :: Int64 -> String +showUint32 = show + +-- | Convert a uint64 to string. +showUint64 :: Integer -> String +showUint64 = show + +-- | 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 + Left _ -> B.empty + Right bs -> bs + +-- | Parse a string as a Scientific decimal. Errors on malformed input. +stringToDecimal :: String -> Scientific +stringToDecimal = read + +-- | Convert a uint8 to a bigint (Integer). +uint8ToBigint :: Int16 -> Integer +uint8ToBigint = fromIntegral + +-- | Convert a uint16 to a bigint (Integer). +uint16ToBigint :: Int -> Integer +uint16ToBigint = fromIntegral + +-- | Convert a uint32 to a bigint (Integer). +uint32ToBigint :: Int64 -> Integer +uint32ToBigint = fromIntegral + +-- | Convert a uint64 to a bigint (Integer). +uint64ToBigint :: Integer -> Integer +uint64ToBigint = id diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Logic.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Logic.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Logic.hs @@ -0,0 +1,24 @@ +-- | Haskell implementations of hydra.lib.logic (logic and control flow) primitives + +module Hydra.Overlay.Haskell.Lib.Logic where + +import Hydra.Core + +import Data.Int + + +-- | Compute the logical AND of two boolean values. +and :: Bool -> Bool -> Bool +and x y = x && y + +-- | Compute a conditional expression. +ifElse :: Bool -> a -> a -> a +ifElse b x y = if b then x else y + +-- | Compute the logical NOT of a boolean value. +not :: Bool -> Bool +not = Prelude.not + +-- | Compute the logical OR of two boolean values. +or :: Bool -> Bool -> Bool +or x y = x || y diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Maps.hs @@ -0,0 +1,86 @@ +-- | Haskell implementations of hydra.lib.maps primitives + +module Hydra.Overlay.Haskell.Lib.Maps where + +import qualified Data.Map as M + + +-- | Alter a value at a key using a function. +alter :: Ord k => (Maybe v -> Maybe v) -> k -> M.Map k v -> M.Map k v +alter = M.alter + +-- | Map a function over the keys and values of a map. +bimap :: (Ord k1, Ord k2) => (k1 -> k2) -> (v1 -> v2) -> M.Map k1 v1 -> M.Map k2 v2 +bimap f g = M.fromList . fmap (\(k, v) -> (f k, g v)) . M.toList + +-- | Remove a key from a map. +delete :: Ord k => k -> M.Map k v -> M.Map k v +delete = M.delete + +-- | Get the values of a map. +elems :: M.Map k v -> [v] +elems = M.elems + +-- | Create an empty map. +empty :: M.Map k v +empty = M.empty + +-- | Filter a map based on values. +filter :: Ord k => (v -> Bool) -> M.Map k v -> M.Map k v +filter = M.filter + +-- | Filter a map based on key-value pairs. +filterWithKey :: Ord k => (k -> v -> Bool) -> M.Map k v -> M.Map k v +filterWithKey = M.filterWithKey + +-- | Lookup a value with a default. +findWithDefault :: Ord k => v -> k -> M.Map k v -> v +findWithDefault = M.findWithDefault + +-- | Create a map from a list of key-value pairs. +fromList :: Ord k => [(k, v)] -> M.Map k v +fromList = M.fromList + +-- | Insert a key-value pair into a map. +insert :: Ord k => k -> v -> M.Map k v -> M.Map k v +insert = M.insert + +-- | Get the keys of a map. +keys :: M.Map k v -> [k] +keys = M.keys + +-- | Lookup a value in a map. +lookup :: Ord k => k -> M.Map k v -> Maybe v +lookup = M.lookup + +-- | Map a function over a map. +map :: (v1 -> v2) -> M.Map k v1 -> M.Map k v2 +map = fmap + +-- | Map a function over the keys of a map. +mapKeys :: (Ord k1, Ord k2) => (k1 -> k2) -> M.Map k1 v -> M.Map k2 v +mapKeys = M.mapKeys + +-- | Check if a key is present in a map. +member :: Ord k => k -> M.Map k v -> Bool +member = M.member + +-- | Check if a map is empty. +null :: M.Map k v -> Bool +null = M.null + +-- | Create a map with a single key-value pair. +singleton :: k -> v -> M.Map k v +singleton = M.singleton + +-- | Get the size of a map. +size :: M.Map k v -> Int +size = M.size + +-- | Convert a map to a list of key-value pairs. +toList :: M.Map k v -> [(k, v)] +toList = M.toList + +-- | 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 diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs @@ -0,0 +1,234 @@ +-- | Haskell implementations of hydra.lib.math primitives + +module Hydra.Overlay.Haskell.Lib.Math where + +import Prelude (Num, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), (.), ($), (+), (-), (*), (==), (||)) +import qualified Prelude + + +-- | Return the absolute value. +abs :: Num a => a -> a +abs = Prelude.abs + +-- | Return the arc cosine of x in radians. +acos :: Double -> Double +acos = Prelude.acos + +-- | Return the inverse hyperbolic cosine of x. +acosh :: Double -> Double +acosh = Prelude.acosh + +-- | Add two numbers. +add :: Num a => a -> a -> a +add x y = x + y + +-- | Add two Float64 numbers. +addFloat64 :: Double -> Double -> Double +addFloat64 = add + +-- | Return the arc sine of x in radians. +asin :: Double -> Double +asin = Prelude.asin + +-- | Return the inverse hyperbolic sine of x. +asinh :: Double -> Double +asinh = Prelude.asinh + +-- | Return the arc tangent of x in radians. +atan :: Double -> Double +atan = Prelude.atan + +-- | Return the arc tangent of y/x in radians, using signs to determine quadrant. +atan2 :: Double -> Double -> Double +atan2 = Prelude.atan2 + +-- | Return the inverse hyperbolic tangent of x. +atanh :: Double -> Double +atanh = Prelude.atanh + +-- | Return the ceiling of x as a float. +-- +-- DIVERGENCE FROM HASKELL: Haskell's Prelude.ceiling returns an Integer, which +-- cannot represent NaN or Inf; GHC's behavior on those inputs is undefined and +-- produces nonsensical gigantic integers. Hydra returns a Float64 instead so +-- that NaN and ±Inf propagate naturally per IEEE 754, matching the conventions +-- of C (ceil), Java (Math.ceil), Go (math.Ceil), Rust (f64::ceil), and JavaScript +-- (Math.ceil). Users who need an Integer value must convert explicitly. +ceiling :: Double -> Double +ceiling x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | Prelude.otherwise = Prelude.fromIntegral (Prelude.ceiling x :: Integer) + +-- | Return the cosine of x radians. +cos :: Double -> Double +cos = Prelude.cos + +-- | Return the hyperbolic cosine of x. +cosh :: Double -> Double +cosh = Prelude.cosh + +-- | Euler's number (e ≈ 2.71828). +e :: Double +e = Prelude.exp 1.0 + +-- | Check if an integer is even. +even :: Integral a => a -> Bool +even = Prelude.even + +-- | Return e raised to the power x. +exp :: Double -> Double +exp = Prelude.exp + +-- | Return the floor of x as a float. +-- +-- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than +-- Integer so that NaN and ±Inf propagate naturally per IEEE 754. +floor :: Double -> Double +floor x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | Prelude.otherwise = Prelude.fromIntegral (Prelude.floor x :: Integer) + +-- | Return the natural logarithm of x. +log :: Double -> Double +log = Prelude.log + +-- | Return the logarithm of x to the given base. +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 + +-- | Mathematical modulo, returning Nothing on division by zero. +maybeMod :: Int -> Int -> Maybe Int +maybeMod _ 0 = Nothing +maybeMod x y = Just (Prelude.mod x y) + +-- | Multiply two numbers. +mul :: Num a => a -> a -> a +mul x y = x * y + +-- | Multiply two Float64 numbers. +mulFloat64 :: Double -> Double -> Double +mulFloat64 = mul + +-- | Negate a number. +negate :: Num a => a -> a +negate = Prelude.negate + +-- | Negate a Float64 number. +negateFloat64 :: Double -> Double +negateFloat64 = Prelude.negate + +-- | Check if an integer is odd. +odd :: Integral a => a -> Bool +odd = Prelude.odd + +-- | Pi (π ≈ 3.14159). +pi :: Double +pi = Prelude.pi + +-- | Return x raised to the power y. +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) + +-- | Return x rounded to the nearest integer, as a float. +-- +-- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than +-- Integer so that NaN and ±Inf propagate naturally per IEEE 754. +round :: Double -> Double +round x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | Prelude.otherwise = Prelude.fromIntegral (Prelude.round x :: Integer) + +-- | Round a float32 to n significant digits. +-- Returns NaN/Inf inputs unchanged (no rounding is possible). +roundFloat32 :: Int -> Float -> Float +roundFloat32 n x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | x Prelude.== 0 = 0 + | Prelude.otherwise = + let factor = 10 Prelude.^^ (n - 1 - Prelude.floor (Prelude.logBase 10 (Prelude.abs x))) + in Prelude.fromIntegral (Prelude.round (x * factor) :: Integer) Prelude./ factor + +-- | Round a float64 to n significant digits. +-- Returns NaN/Inf inputs unchanged (no rounding is possible). +roundFloat64 :: Int -> Double -> Double +roundFloat64 n x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | x Prelude.== 0 = 0 + | Prelude.otherwise = + let factor = 10 Prelude.^^ (n - 1 - Prelude.floor (Prelude.logBase 10 (Prelude.abs x))) + in Prelude.fromIntegral (Prelude.round (x * factor) :: Integer) Prelude./ factor + +-- | Return the sign of a number (-1, 0, or 1). +signum :: Num a => a -> a +signum = Prelude.signum + +-- | Return the sine of x radians. +sin :: Double -> Double +sin = Prelude.sin + +-- | Return the hyperbolic sine of x. +sinh :: Double -> Double +sinh = Prelude.sinh + +-- | Return the square root of x. +sqrt :: Double -> Double +sqrt = Prelude.sqrt + +-- | Subtract two numbers. +sub :: Num a => a -> a -> a +sub x y = x - y + +-- | Subtract two Float64 numbers. +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 +tan = Prelude.tan + +-- | Return the hyperbolic tangent of x. +tanh :: Double -> Double +tanh = Prelude.tanh + +-- | Return x truncated (towards zero), as a float. +-- +-- DIVERGENCE FROM HASKELL: see the note on ceiling. Returns Float64 rather than +-- Integer so that NaN and ±Inf propagate naturally per IEEE 754. +truncate :: Double -> Double +truncate x + | Prelude.isNaN x Prelude.|| Prelude.isInfinite x = x + | Prelude.otherwise = Prelude.fromIntegral (Prelude.truncate x :: Integer) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Optionals.hs @@ -0,0 +1,54 @@ +-- | Haskell implementations of hydra.lib.optionals primitives + +module Hydra.Overlay.Haskell.Lib.Optionals where + +import qualified Data.Maybe as Y + + +-- | Apply a function to an argument (applicative). +apply :: Y.Maybe (a -> b) -> Y.Maybe a -> Y.Maybe b +apply = (<*>) + +-- | Chain operations on optional values, handling absent cases automatically. +bind :: Y.Maybe a -> (a -> Y.Maybe b) -> Y.Maybe b +bind = (>>=) + +-- | Handle an optional value with the absent-case value as the first argument. +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 + +-- | Check if a value is present. +isGiven :: Y.Maybe a -> Bool +isGiven = Y.isJust + +-- | Check if a value is absent. +isNone :: Y.Maybe a -> Bool +isNone = Y.isNothing + +-- | Map a function over an optional value. +map :: (a -> b) -> Y.Maybe a -> Y.Maybe b +map = fmap + +-- | Map a function over a list and collect present results. +mapOptional :: (a -> Y.Maybe b) -> [a] -> [b] +mapOptional = Y.mapMaybe + +-- | Lift a value into the optional type. +pure :: a -> Y.Maybe a +pure = Just + +-- | Convert an optional value to a list: a present value becomes [x], an absent value becomes []. +toList :: Y.Maybe a -> [a] +toList = Y.maybeToList diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Pairs.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Pairs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Pairs.hs @@ -0,0 +1,18 @@ +-- | Haskell implementations of hydra.lib.pairs primitives + +module Hydra.Overlay.Haskell.Lib.Pairs where + +import qualified Data.Bifunctor as BF + + +-- | Map over both elements of a pair. +bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d) +bimap = BF.bimap + +-- | Get the first element of a pair. +first :: (a, b) -> a +first (x, _) = x + +-- | Get the second element of a pair. +second :: (a, b) -> b +second (_, y) = y diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Regex.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Regex.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Regex.hs @@ -0,0 +1,48 @@ +-- | Haskell implementations of hydra.lib.regex primitives + +module Hydra.Overlay.Haskell.Lib.Regex where + +import qualified Text.Regex.TDFA as R + + +-- | Find the first substring matching a regex pattern. +find :: String -> String -> Maybe String +find pattern input = case (input R.=~ pattern :: (String, String, String)) of + (_, match, _) + | null match -> Nothing + | otherwise -> Just match + +-- | Find all non-overlapping substrings matching a regex pattern. +findAll :: String -> String -> [String] +findAll pattern input = R.getAllTextMatches (input R.=~ pattern :: R.AllTextMatches [] String) + +-- | Check whether an entire string matches a regex pattern. +matches :: String -> String -> Bool +matches pattern input = input R.=~ ("^(" ++ pattern ++ ")$" :: String) :: Bool + +-- | Replace the first occurrence of a regex pattern with a replacement string. +replace :: String -> String -> String -> String +replace pattern replacement input = case (input R.=~ pattern :: (String, String, String)) of + (before, match, after) + | null match -> input + | otherwise -> before ++ replacement ++ after + +-- | Replace all non-overlapping occurrences of a regex pattern with a replacement string. +replaceAll :: String -> String -> String -> String +replaceAll pattern replacement input = go input + where + go "" = "" + go s = case (s R.=~ pattern :: (String, String, String)) of + (before, match, after) + | null match -> s + | otherwise -> before ++ replacement ++ go after + +-- | Split a string by a regex pattern. +split :: String -> String -> [String] +split pattern input = go input + where + go "" = [""] + go s = case (s R.=~ pattern :: (String, String, String)) of + (before, match, after) + | null match -> [s] + | otherwise -> before : go after diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Sets.hs @@ -0,0 +1,64 @@ +-- | Haskell implementations of hydra.lib.sets primitives + +module Hydra.Overlay.Haskell.Lib.Sets where + +import qualified Data.Set as S + + +-- | Delete an element from a set. +delete :: Ord x => x -> S.Set x -> S.Set x +delete = S.delete + +-- | Compute the difference of two sets. +difference :: Ord x => S.Set x -> S.Set x -> S.Set x +difference = S.difference + +-- | Create an empty set. +empty :: S.Set x +empty = S.empty + +-- | Create a set from a list. +fromList :: Ord x => [x] -> S.Set x +fromList = S.fromList + +-- | Insert an element into a set. +insert :: Ord x => x -> S.Set x -> S.Set x +insert = S.insert + +-- | Compute the intersection of two sets. +intersection :: Ord x => S.Set x -> S.Set x -> S.Set x +intersection = S.intersection + +-- | Map a function over a set. +-- Note: the presence of a 'map' function does not imply that sets are a functor in Hydra +map :: Ord y => (x -> y) -> S.Set x -> S.Set y +map f = S.fromList . fmap f . S.toList + +-- | Check if an element is in a set. +member :: Ord x => x -> S.Set x -> Bool +member = S.member + +-- | Check if a set is empty. +null :: S.Set x -> Bool +null = S.null + +-- | Create a singleton set. +-- Consider renaming this to Sets.pure, or creating an alias +singleton :: x -> S.Set x +singleton = S.singleton + +-- | Get the size of a set. +size :: S.Set x -> Int +size = S.size + +-- | Convert a set to a list. +toList :: Ord x => S.Set x -> [x] +toList = S.toList + +-- | Compute the union of two sets. +union :: Ord x => S.Set x -> S.Set x -> S.Set x +union = S.union + +-- | Compute the union of multiple sets. +unions :: Ord x => [S.Set x] -> S.Set x +unions = S.unions diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Strings.hs @@ -0,0 +1,62 @@ +-- | Haskell implementations of hydra.lib.strings primitives + +module Hydra.Overlay.Haskell.Lib.Strings where + +import qualified Data.Char as C +import qualified Data.List as L +import qualified Data.List.Split as LS + + +-- | Concatenate a list of strings into a single string. +cat :: [String] -> String +cat = L.concat + +-- | Concatenate two strings. +cat2 :: String -> String -> String +cat2 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 + +-- | 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] +lines = L.lines + +-- | Check whether a string is empty. +null :: String -> Bool +null = L.null + +-- | Split a string on a delimiter string. +splitOn :: String -> String -> [String] +splitOn = LS.splitOn + +-- | Convert a string to a list of Unicode code points. +toList :: String -> [Int] +toList = fmap C.ord + +-- | Convert a string to lowercase. +toLower :: String -> String +toLower = fmap C.toLower + +-- | Convert a string to uppercase. +toUpper :: String -> String +toUpper = fmap C.toUpper + +-- | Join a list of strings with newlines, appending a trailing newline. +unlines :: [String] -> String +unlines = L.unlines diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/System.hs @@ -0,0 +1,95 @@ +-- | Haskell implementations of hydra.lib.system primitives + +module Hydra.Overlay.Haskell.Lib.System where + +import qualified Control.Exception as E +import qualified Data.ByteString as BS +import qualified Data.Map as M +import qualified Data.Maybe as Y +import qualified Hydra.Error.System as SystemError +import qualified Hydra.File as File +import qualified Hydra.System as System +import qualified Hydra.Time as Time +import Data.Time.Clock.POSIX (getPOSIXTime) +import System.Exit (ExitCode(..), exitWith) +import qualified System.Directory as Dir +import qualified System.Environment as Env +import qualified System.IO.Error as IOE +import qualified System.Process as P + + +-- | Run a program to completion and capture its result. +execute :: System.Command -> IO (Either SystemError.SystemError System.ProcessResult) +execute command = + let program = File.unFilePath (System.commandProgram command) + args = System.commandArguments command + cwd = fmap File.unFilePath (System.commandWorkingDirectory command) + env = fmap toEnvList (System.commandEnvironment command) + proc0 = (P.proc program args) { + P.cwd = cwd, + P.env = env, + P.std_out = P.CreatePipe, + P.std_err = P.CreatePipe} + in E.catch (runProcess proc0) (pure . Left . classify (System.commandProgram command)) + +-- | Terminate the current process with a status code. +exit :: System.StatusCode -> IO () +exit code = + let n = System.unStatusCode code + in exitWith (if n == 0 then ExitSuccess else ExitFailure (fromIntegral n)) + +-- | Get the full set of environment variables. +getEnvironment :: IO (M.Map System.EnvironmentVariable String) +getEnvironment = do + pairs <- Env.getEnvironment + pure $ M.fromList [(System.EnvironmentVariable k, v) | (k, v) <- pairs] + +-- | Look up a single environment variable by name. +getEnvironmentVariable :: System.EnvironmentVariable -> IO (Maybe String) +getEnvironmentVariable name = + Env.lookupEnv (System.unEnvironmentVariable name) + +-- | Get the current wall-clock time. +getTime :: IO Time.Timespec +getTime = do + t <- getPOSIXTime + let picos = floor (toRational t * 1000000000000) :: Integer + (secs, subPicos) = picos `divMod` 1000000000000 + nanos = subPicos `div` 1000 + pure Time.Timespec { + Time.timespecSeconds = fromInteger secs, + Time.timespecNanoseconds = fromInteger nanos} + +-- | Get the current working directory. +getWorkingDirectory :: IO (Either SystemError.SystemError File.FilePath) +getWorkingDirectory = + E.catch (Right . File.FilePath <$> Dir.getCurrentDirectory) + (\e -> pure $ Left $ SystemError.SystemErrorOther (IOE.ioeGetErrorString (e :: IOError))) + +-- Helpers (not primitives) + +-- | Convert the environment map to the association list System.Process expects. +toEnvList :: M.Map System.EnvironmentVariable String -> [(String, String)] +toEnvList m = [(System.unEnvironmentVariable k, v) | (k, v) <- M.toList m] + +-- | Run a prepared process, capturing stdout/stderr as bytes and the exit code. +runProcess :: P.CreateProcess -> IO (Either SystemError.SystemError System.ProcessResult) +runProcess cp = do + (_, mout, merr, ph) <- P.createProcess cp + out <- Y.maybe (pure BS.empty) BS.hGetContents mout + err <- Y.maybe (pure BS.empty) BS.hGetContents merr + ec <- P.waitForProcess ph + let code = case ec of + ExitSuccess -> 0 + ExitFailure n -> fromIntegral n + pure $ Right System.ProcessResult { + System.processResultExitCode = System.StatusCode code, + System.processResultStdout = out, + System.processResultStderr = err} + +-- | Classify a launch IOError into a SystemError. +classify :: File.FilePath -> IOError -> SystemError.SystemError +classify program e + | IOE.isDoesNotExistError e = SystemError.SystemErrorCommandNotFound program + | IOE.isPermissionError e = SystemError.SystemErrorPermissionDenied program + | otherwise = SystemError.SystemErrorOther (IOE.ioeGetErrorString e) diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Lib/Text.hs b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Text.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Lib/Text.hs @@ -0,0 +1,20 @@ +-- | Haskell implementations of hydra.lib.text primitives + +module Hydra.Overlay.Haskell.Lib.Text where + +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TEE + + +-- | Decode a sequence of bytes as UTF-8 text, returning Left with a host-provided +-- message if the bytes are not valid UTF-8. +decodeUtf8 :: BS.ByteString -> Either String String +decodeUtf8 bytes = case TE.decodeUtf8' bytes of + Left err -> Left (show (err :: TEE.UnicodeException)) + Right t -> Right (T.unpack t) + +-- | Encode text as a sequence of UTF-8 bytes. Total: every string is valid Unicode. +encodeUtf8 :: String -> BS.ByteString +encodeUtf8 = TE.encodeUtf8 . T.pack diff --git a/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs b/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs @@ -0,0 +1,479 @@ + +-- | Implementations of the Hydra standard libraries in Haskell +module Hydra.Overlay.Haskell.Libraries ( + module Hydra.Overlay.Haskell.Libraries, +) where + +import Hydra.Kernel +import Hydra.Overlay.Haskell.Dsl.Prims as Prims +import qualified Hydra.Overlay.Haskell.Dsl.Terms as Terms +import qualified Hydra.Overlay.Haskell.Dsl.Types as Types + +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.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.Pairs as Pairs +import qualified Hydra.Overlay.Haskell.Lib.Regex as Regex +import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Text as Text +import qualified Hydra.Lib.Chars as DefChars +import qualified Hydra.Lib.Effects as DefEffects +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.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.Pairs as DefPairs +import qualified Hydra.Lib.Regex as DefRegex +import qualified Hydra.Lib.Sets as DefSets +import qualified Hydra.Lib.Strings as DefStrings +import qualified Hydra.Lib.System as DefSystem +import qualified Hydra.Lib.Text as DefText + +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" +b_ = variable "b" +c_ = variable "c" +d_ = variable "d" +k_ = variable "k" +k1_ = variable "k1" +k2_ = variable "k2" +s_ = variable "s" +v_ = variable "v" +v1_ = variable "v1" +v2_ = variable "v2" +w_ = variable "w" +x_ = variable "x" +y_ = variable "y" +z_ = variable "z" + +-- | A TermCoder for function types which uses beta reduction to bridge term-level +-- functions to native functions. This allows higher-order primitives like map, +-- filter, foldl, etc. to use native implementations rather than eval-level ones. +-- Used by the DYNAMIC higher-order primitives (those that must inspect a reduced +-- per-element application result), pending their migration to term-level +-- defaultImplementations under issue #446. +fun :: TermCoder x -> TermCoder y -> TermCoder (x -> y) +fun = Prims.functionWithReduce (\cx g t -> reduceTerm cx g True t) + +-- | A graph-free TermCoder for function types (issue #446): the bridged native function builds an +-- unreduced @apply funTerm argTerm@ term and lets the outer reducer fold it, rather than calling +-- the reducer here. Used by the STATIC higher-order primitives — those whose result shape is fixed +-- by the (already-reduced) data argument's spine, so they never inspect a reduced per-element +-- application. This is the form that requires no InferenceContext/Graph, enabling the carrier drop. +funT :: TermCoder x -> TermCoder y -> TermCoder (x -> y) +funT = Prims.functionDeferred + +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] + +hydraLibEffects :: Library +hydraLibEffects = standardLibrary [ + unsupportedEffectPrimitive DefEffects.apply, + unsupportedEffectPrimitive DefEffects.bind, + unsupportedEffectPrimitive DefEffects.compose, + unsupportedEffectPrimitive DefEffects.foldl, + unsupportedEffectPrimitive DefEffects.map, + unsupportedEffectPrimitive DefEffects.mapList, + unsupportedEffectPrimitive DefEffects.mapOptional, + unsupportedEffectPrimitive DefEffects.pure] + +hydraLibFiles :: Library +hydraLibFiles = standardLibrary [ + unsupportedEffectPrimitive DefFiles.appendFile, + unsupportedEffectPrimitive DefFiles.copy, + unsupportedEffectPrimitive DefFiles.createDirectory, + unsupportedEffectPrimitive DefFiles.exists, + unsupportedEffectPrimitive DefFiles.listDirectory, + unsupportedEffectPrimitive DefFiles.readFile, + unsupportedEffectPrimitive DefFiles.removeDirectory, + unsupportedEffectPrimitive DefFiles.removeFile, + unsupportedEffectPrimitive DefFiles.rename, + unsupportedEffectPrimitive DefFiles.status, + unsupportedEffectPrimitive DefFiles.writeFile] + +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_)] + +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_] + +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_)] + +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] + +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] + +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] + 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] + +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)] + +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_)] + +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_] + +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)] + +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_)] + +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] + +hydraLibSystem :: Library +hydraLibSystem = standardLibrary [ + unsupportedEffectPrimitive DefSystem.execute, + unsupportedEffectPrimitive DefSystem.exit, + unsupportedEffectPrimitive DefSystem.getEnvironment, + unsupportedEffectPrimitive DefSystem.getEnvironmentVariable, + unsupportedEffectPrimitive DefSystem.getTime, + unsupportedEffectPrimitive DefSystem.getWorkingDirectory] + +hydraLibText :: Library +hydraLibText = standardLibrary [ + prim1 DefText.decodeUtf8 Text.decodeUtf8 [] binary (Prims.either_ string string), + prim1 DefText.encodeUtf8 Text.encodeUtf8 [] string binary] + +standardLibraries :: [Library] +standardLibraries = [ + hydraLibChars, + hydraLibEffects, + hydraLibEithers, + hydraLibEquality, + hydraLibFiles, + hydraLibLists, + hydraLibLiterals, + hydraLibLogic, + hydraLibMaps, + hydraLibMathFloat64, + hydraLibMathInt32, + hydraLibOptionals, + hydraLibPairs, + hydraLibRegex, + hydraLibSets, + hydraLibStrings, + hydraLibSystem, + hydraLibText] + +-- | Assemble a library from its primitives. The library's module name (e.g. "hydra.lib.chars") +-- is *derived* from the primitives' shared namespace rather than passed as a literal string (#473): +-- every primitive in a library shares the namespace, so it is read off the first one's +-- PrimitiveDefinition name. Fails loudly on an empty list. +standardLibrary :: [Primitive] -> Library +standardLibrary [] = error "standardLibrary: empty primitive list (cannot derive module name)" +standardLibrary prims = Library { + libraryName = ns, + libraryPrefix = L.drop (L.length ("hydra.lib." :: String)) $ unModuleName ns, + libraryPrimitives = prims} + where + -- namespace = the primitive name with its final "." segment dropped + firstName = unName $ primitiveDefinitionName $ primitiveDefinition $ head prims + ns = ModuleName $ reverse $ L.drop 1 $ L.dropWhile (/= '.') $ reverse firstName + +-- | Register effect primitives for name resolution and inference, while keeping +-- Hydra's pure reducer from interpreting host effects as ordinary terms. +unsupportedEffectPrimitive :: PrimitiveDefinition -> Primitive +unsupportedEffectPrimitive def = Primitive def implementation + where + implementation _ _ = Left $ ErrorOther $ OtherError $ + "effect primitive cannot be reduced by Hydra's pure Haskell reducer: " + ++ unName (primitiveDefinitionName def) diff --git a/src/main/haskell/Hydra/Packaging.hs b/src/main/haskell/Hydra/Packaging.hs --- a/src/main/haskell/Hydra/Packaging.hs +++ b/src/main/haskell/Hydra/Packaging.hs @@ -1,37 +1,72 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model for Hydra module names, modules, and packages module Hydra.Packaging where + import qualified Hydra.Core as Core import qualified Hydra.Typing as Typing import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | A definition, which may be either a term, type, or primitive definition data Definition = + -- | A primitive definition + DefinitionPrimitive PrimitiveDefinition | -- | A term definition DefinitionTerm TermDefinition | -- | A type definition - DefinitionType TypeDefinition | - -- | A primitive definition - DefinitionPrimitive PrimitiveDefinition + DefinitionType TypeDefinition deriving (Eq, Ord, Read, Show) + _Definition = Core.Name "hydra.packaging.Definition" + +_Definition_primitive = Core.Name "primitive" + _Definition_term = Core.Name "term" + _Definition_type = Core.Name "type" -_Definition_primitive = Core.Name "primitive" + -- | A typed reference to a definition: a type, a term, or a primitive, identified by name data DefinitionReference = - -- | A reference to a type definition, by name - DefinitionReferenceType Core.Name | + -- | A reference to a primitive definition, by name + DefinitionReferencePrimitive Core.Name | -- | A reference to a term definition, by name DefinitionReferenceTerm Core.Name | - -- | A reference to a primitive definition, by name - DefinitionReferencePrimitive Core.Name + -- | A reference to a type definition, by name + DefinitionReferenceType Core.Name deriving (Eq, Ord, Read, Show) + _DefinitionReference = Core.Name "hydra.packaging.DefinitionReference" -_DefinitionReference_type = Core.Name "type" -_DefinitionReference_term = Core.Name "term" + _DefinitionReference_primitive = Core.Name "primitive" + +_DefinitionReference_term = Core.Name "term" + +_DefinitionReference_type = Core.Name "type" + +-- | The scope in which a package dependency is required. Relevant mainly to dependencies on third-party (non-Hydra) artifacts, where build systems distinguish compile-time, runtime, test-only, and build-tool-only dependencies. Hydra inter-package dependencies normally leave the scope unspecified. +data DependencyScope = + -- | A dependency exported transitively to consumers of this package (e.g. Gradle `api`, Cabal `build-depends`): present at both compile time and runtime, and visible downstream + DependencyScopeApi | + -- | A dependency required at runtime but not at compile time + DependencyScopeRuntime | + -- | A dependency required only to compile and run the package's tests + DependencyScopeTest | + -- | A build-tool-only dependency, used to generate or process sources at build time but not present in the compiled artifact (e.g. an ANTLR tool jar or an annotation processor) + DependencyScopeTool + deriving (Eq, Ord, Read, Show) + +_DependencyScope = Core.Name "hydra.packaging.DependencyScope" + +_DependencyScope_api = Core.Name "api" + +_DependencyScope_runtime = Core.Name "runtime" + +_DependencyScope_test = Core.Name "test" + +_DependencyScope_tool = Core.Name "tool" + -- | Documentation and lifecycle metadata attachable to a packaging entity (package, module, or definition). Bundling these fields in one type lets future metadata be added without changing the field shape of the entities that carry it. data EntityMetadata = EntityMetadata { @@ -44,24 +79,43 @@ -- | Optional version-lifecycle milestones for the entity. entityMetadataLifecycle :: (Maybe LifecycleInfo)} deriving (Eq, Ord, Read, Show) + _EntityMetadata = Core.Name "hydra.packaging.EntityMetadata" + _EntityMetadata_description = Core.Name "description" + _EntityMetadata_comments = Core.Name "comments" + _EntityMetadata_seeAlso = Core.Name "seeAlso" + _EntityMetadata_lifecycle = Core.Name "lifecycle" --- | A typed reference to a packaging entity: a package, a module, or a definition + +-- | A typed reference to a Hydra entity: a package, a module, a definition (by name), or an inline type or term expression in Hydra textual syntax. data EntityReference = - -- | A reference to a package, by name - EntityReferencePackage PackageName | + -- | A reference to a definition (type, term, or primitive), by name + EntityReferenceDefinition DefinitionReference | -- | A reference to a module, by name EntityReferenceModule ModuleName | - -- | A reference to a definition (type, term, or primitive) - EntityReferenceDefinition DefinitionReference + -- | A reference to a package, by name + EntityReferencePackage PackageName | + -- | An inline term expression in Hydra textual syntax + EntityReferenceTermExpr String | + -- | An inline type expression in Hydra textual syntax + EntityReferenceTypeExpr String deriving (Eq, Ord, Read, Show) + _EntityReference = Core.Name "hydra.packaging.EntityReference" -_EntityReference_package = Core.Name "package" -_EntityReference_module = Core.Name "module" + _EntityReference_definition = Core.Name "definition" + +_EntityReference_module = Core.Name "module" + +_EntityReference_package = Core.Name "package" + +_EntityReference_termExpr = Core.Name "termExpr" + +_EntityReference_typeExpr = Core.Name "typeExpr" + -- | Version-lifecycle milestones for a packaging entity. Each milestone is independently optional; further milestones (e.g. stableSince, removedSince) may be added without changing dependent types. data LifecycleInfo = LifecycleInfo { @@ -70,9 +124,13 @@ -- | The version in which the entity was deprecated, if applicable. lifecycleInfoDeprecatedSince :: (Maybe Version)} deriving (Eq, Ord, Read, Show) + _LifecycleInfo = Core.Name "hydra.packaging.LifecycleInfo" + _LifecycleInfo_availableSince = Core.Name "availableSince" + _LifecycleInfo_deprecatedSince = Core.Name "deprecatedSince" + -- | A logical collection of elements sharing a common module name, having dependencies on zero or more other modules data Module = Module { @@ -85,11 +143,17 @@ -- | The definitions in this module moduleDefinitions :: [Definition]} deriving (Eq, Ord, Read, Show) + _Module = Core.Name "hydra.packaging.Module" + _Module_name = Core.Name "name" + _Module_metadata = Core.Name "metadata" + _Module_dependencies = Core.Name "dependencies" + _Module_definitions = Core.Name "definitions" + -- | A dependency on another module, identified by its name and (optionally) the package which provides it. When the package is omitted, the resolver searches all packages in scope; a duplicate module name across packages is a resolution error which can be disambiguated by naming the intended package explicitly. data ModuleDependency = ModuleDependency { @@ -98,15 +162,21 @@ -- | The package providing the depended-on module, if disambiguation is required moduleDependencyPackage :: (Maybe PackageName)} deriving (Eq, Ord, Read, Show) + _ModuleDependency = Core.Name "hydra.packaging.ModuleDependency" + _ModuleDependency_module = Core.Name "module" + _ModuleDependency_package = Core.Name "package" + -- | The unique name of a module; a prefix for the names of elements defined in the module. newtype ModuleName = ModuleName { unModuleName :: String} deriving (Eq, Ord, Read, Show) + _ModuleName = Core.Name "hydra.packaging.ModuleName" + -- | A package, which is a named collection of modules with metadata and dependencies data Package = Package { @@ -119,28 +189,44 @@ -- | The modules in this package packageModules :: [Module]} deriving (Eq, Ord, Read, Show) + _Package = Core.Name "hydra.packaging.Package" + _Package_name = Core.Name "name" + _Package_metadata = Core.Name "metadata" + _Package_dependencies = Core.Name "dependencies" + _Package_modules = Core.Name "modules" + -- | A dependency on another package, identified by name and constrained by an optional version specifier data PackageDependency = PackageDependency { -- | The name of the depended-on package packageDependencyName :: PackageName, -- | The version-range constraint on the depended-on package - packageDependencyVersion :: VersionSpecifier} + packageDependencyVersion :: VersionSpecifier, + -- | The scope in which the dependency is required, if specified. Normally absent for Hydra inter-package dependencies; specified for third-party dependencies whose build scope (compile/runtime/test/tool) is significant. + packageDependencyScope :: (Maybe DependencyScope)} deriving (Eq, Ord, Read, Show) + _PackageDependency = Core.Name "hydra.packaging.PackageDependency" + _PackageDependency_name = Core.Name "name" + _PackageDependency_version = Core.Name "version" --- | The unique name of a package, e.g. "hydra-kernel" or "hydra-python" + +_PackageDependency_scope = Core.Name "scope" + +-- | The unique name of a package, e.g. "hydra-kernel" or "hydra-python". For dependencies on third-party artifacts in ecosystems with a group/namespace component (notably Maven), the group and artifact are carried in a single name separated by a colon, e.g. "org.eclipse.rdf4j:rdf4j-rio-ntriples"; the consuming host splits on the colon to recover the group when emitting build configuration. Hydra package names contain no colon. newtype PackageName = PackageName { unPackageName :: String} deriving (Eq, Ord, Read, Show) + _PackageName = Core.Name "hydra.packaging.PackageName" + -- | A primitive definition: the universal, host-independent declarative metadata for a primitive, including name, signature, documentation and lifecycle metadata, totality and purity flags, and an optional default implementation expressed as a Hydra term. data PrimitiveDefinition = PrimitiveDefinition { @@ -157,13 +243,21 @@ -- | An optional cross-compilable reference implementation of the primitive, expressed as a Hydra term. Used by interpreters lacking a native implementation and as a proof-friendly reference. Distinct from the per-host Primitive.implementation. primitiveDefinitionDefaultImplementation :: (Maybe Core.Term)} deriving (Eq, Ord, Read, Show) + _PrimitiveDefinition = Core.Name "hydra.packaging.PrimitiveDefinition" + _PrimitiveDefinition_name = Core.Name "name" + _PrimitiveDefinition_metadata = Core.Name "metadata" + _PrimitiveDefinition_signature = Core.Name "signature" + _PrimitiveDefinition_isPure = Core.Name "isPure" + _PrimitiveDefinition_isTotal = Core.Name "isTotal" + _PrimitiveDefinition_defaultImplementation = Core.Name "defaultImplementation" + -- | A term-level definition, including a name, an optional signature, and a term data TermDefinition = TermDefinition { @@ -176,11 +270,17 @@ -- | The term being defined termDefinitionBody :: Core.Term} deriving (Eq, Ord, Read, Show) + _TermDefinition = Core.Name "hydra.packaging.TermDefinition" + _TermDefinition_name = Core.Name "name" + _TermDefinition_metadata = Core.Name "metadata" + _TermDefinition_signature = Core.Name "signature" + _TermDefinition_body = Core.Name "body" + -- | A type-level definition, including a name and the type scheme data TypeDefinition = TypeDefinition { @@ -191,20 +291,56 @@ -- | The type scheme being defined typeDefinitionBody :: Core.TypeScheme} deriving (Eq, Ord, Read, Show) + _TypeDefinition = Core.Name "hydra.packaging.TypeDefinition" + _TypeDefinition_name = Core.Name "name" + _TypeDefinition_metadata = Core.Name "metadata" + _TypeDefinition_body = Core.Name "body" + -- | A version string, e.g. "0.15" or "1.0.0". newtype Version = Version { unVersion :: String} deriving (Eq, Ord, Read, Show) + _Version = Core.Name "hydra.packaging.Version" --- | A specifier constraining acceptable versions of a dependency. Currently only the `any` (unit) specifier is defined; future variants such as `exact`, `caret`, and `range` may be added without breaking consumers of the `any` form. + +-- | A version range with an optional inclusive lower bound and an optional exclusive upper bound. +data VersionRange = + VersionRange { + -- | The inclusive lower bound, if any (the minimum acceptable version). + versionRangeLowerInclusive :: (Maybe Version), + -- | The exclusive upper bound, if any (versions strictly below this are acceptable). + versionRangeUpperExclusive :: (Maybe Version)} + deriving (Eq, Ord, Read, Show) + +_VersionRange = Core.Name "hydra.packaging.VersionRange" + +_VersionRange_lowerInclusive = Core.Name "lowerInclusive" + +_VersionRange_upperExclusive = Core.Name "upperExclusive" + +-- | A specifier constraining acceptable versions of a dependency. Build systems render each variant into their own syntax (e.g. a range becomes ">=3.7,<4.0" for PyPI or "[3.7,4.0)" for Maven). Further variants such as `caret` may be added without breaking consumers of the existing forms. data VersionSpecifier = -- | Any version satisfies the dependency - VersionSpecifierAny + VersionSpecifierAny | + -- | Exactly the given version satisfies the dependency; used to pin a specific release + VersionSpecifierExact Version | + -- | Any version greater than or equal to the given version (e.g. PyPI ">=7.0") + VersionSpecifierAtLeast Version | + -- | A version range with an optional inclusive lower bound and optional exclusive upper bound (e.g. ">=3.7,<4.0") + VersionSpecifierRange VersionRange deriving (Eq, Ord, Read, Show) + _VersionSpecifier = Core.Name "hydra.packaging.VersionSpecifier" + _VersionSpecifier_any = Core.Name "any" + +_VersionSpecifier_exact = Core.Name "exact" + +_VersionSpecifier_atLeast = Core.Name "atLeast" + +_VersionSpecifier_range = Core.Name "range" 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 @@ -1,28 +1,36 @@ -- Note: this is an automatically generated file. Do not edit. + -- | General-purpose parser combinators module Hydra.Parsers 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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -31,6 +39,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Try the first parser; if it fails without consuming input, try the second alt :: Parsing.Parser t0 -> Parsing.Parser t0 -> Parsing.Parser t0 alt p1 p2 = @@ -40,9 +49,11 @@ Parsing.ParseResultSuccess v0 -> Parsing.ParseResultSuccess v0 Parsing.ParseResultFailure v0 -> Logic.ifElse (Equality.equal (Parsing.parseErrorRemainder v0) input) (Parsing.unParser p2 input) (Parsing.ParseResultFailure v0)) (Parsing.unParser p1 input) in (Parsing.Parser parse) + -- | Parse any single character (codepoint) anyChar :: Parsing.Parser Int anyChar = satisfy (\_ -> True) + -- | Apply a parser containing a function to a parser containing a value apply :: Parsing.Parser (t0 -> t1) -> Parsing.Parser t0 -> Parsing.Parser t1 apply pf pa = @@ -56,9 +67,11 @@ Parsing.ParseResultFailure v1 -> Parsing.ParseResultFailure v1) (Parsing.unParser pa (Parsing.parseSuccessRemainder v0)) Parsing.ParseResultFailure v0 -> Parsing.ParseResultFailure v0) (Parsing.unParser pf input) in (Parsing.Parser parse) + -- | Parse something between an opening and closing parser between :: Parsing.Parser t0 -> Parsing.Parser t1 -> Parsing.Parser t2 -> Parsing.Parser t2 between open close p = bind open (\_ -> bind p (\x -> bind close (\_2 -> pure x))) + -- | Sequence two parsers, passing the result of the first to a function that produces the second bind :: Parsing.Parser t0 -> (t0 -> Parsing.Parser t1) -> Parsing.Parser t1 bind pa f = @@ -68,12 +81,15 @@ Parsing.ParseResultSuccess v0 -> Parsing.unParser (f (Parsing.parseSuccessValue v0)) (Parsing.parseSuccessRemainder v0) Parsing.ParseResultFailure v0 -> Parsing.ParseResultFailure v0) (Parsing.unParser pa input) in (Parsing.Parser parse) + -- | Parse a specific character (codepoint) char :: Int -> Parsing.Parser Int char c = satisfy (\x -> Equality.equal x c) + -- | Try each parser in the list until one succeeds choice :: [Parsing.Parser t0] -> Parsing.Parser t0 choice ps = Lists.foldl alt (fail "no choice matched") ps + -- | A parser that succeeds only at the end of input eof :: Parsing.Parser () eof = @@ -82,18 +98,22 @@ Parsing.parseSuccessRemainder = ""})) (Parsing.ParseResultFailure (Parsing.ParseError { Parsing.parseErrorMessage = "expected end of input", Parsing.parseErrorRemainder = input}))) + -- | A parser that always fails with the given error message fail :: String -> Parsing.Parser t0 fail msg = Parsing.Parser (\input -> Parsing.ParseResultFailure (Parsing.ParseError { Parsing.parseErrorMessage = msg, Parsing.parseErrorRemainder = input})) + -- | Create a parser that defers construction of another parser until parsing time. This is essential for breaking recursive parser definitions. lazy :: (() -> Parsing.Parser t0) -> Parsing.Parser t0 lazy f = Parsing.Parser (\input -> Parsing.unParser (f ()) input) + -- | Parse zero or more occurrences of the given parser many :: Parsing.Parser t0 -> Parsing.Parser [t0] many p = alt (some p) (pure []) + -- | Apply a function to the result of a parser map :: (t0 -> t1) -> Parsing.Parser t0 -> Parsing.Parser t1 map f pa = @@ -105,18 +125,22 @@ Parsing.parseSuccessRemainder = (Parsing.parseSuccessRemainder v0)}) Parsing.ParseResultFailure v0 -> Parsing.ParseResultFailure v0) (Parsing.unParser pa input) in (Parsing.Parser parse) + -- | Optionally parse something, returning Nothing if it fails optional :: Parsing.Parser t0 -> Parsing.Parser (Maybe t0) optional p = alt (map Optionals.pure p) (pure Nothing) + -- | A parser that always succeeds with the given value without consuming input pure :: t0 -> Parsing.Parser t0 pure a = Parsing.Parser (\input -> Parsing.ParseResultSuccess (Parsing.ParseSuccess { Parsing.parseSuccessValue = a, Parsing.parseSuccessRemainder = input})) + -- | Run a parser on the given input string runParser :: Parsing.Parser t0 -> String -> Parsing.ParseResult t0 runParser p input = Parsing.unParser p input + -- | Parse a character (codepoint) that satisfies the given predicate satisfy :: (Int -> Bool) -> Parsing.Parser Int satisfy pred = @@ -134,15 +158,19 @@ Parsing.parseErrorMessage = "character did not satisfy predicate", Parsing.parseErrorRemainder = input}))))) in (Parsing.Parser parse) + -- | Parse zero or more occurrences separated by a separator sepBy :: Parsing.Parser t0 -> Parsing.Parser t1 -> Parsing.Parser [t0] sepBy p sep = alt (sepBy1 p sep) (pure []) + -- | Parse one or more occurrences separated by a separator sepBy1 :: Parsing.Parser t0 -> Parsing.Parser t1 -> Parsing.Parser [t0] sepBy1 p sep = bind p (\x -> bind (many (bind sep (\_ -> p))) (\xs -> pure (Lists.cons x xs))) + -- | Parse one or more occurrences of the given parser some :: Parsing.Parser t0 -> Parsing.Parser [t0] some p = bind p (\x -> bind (many p) (\xs -> pure (Lists.cons x xs))) + -- | Parse a specific string string :: String -> Parsing.Parser String string str = diff --git a/src/main/haskell/Hydra/Parsing.hs b/src/main/haskell/Hydra/Parsing.hs --- a/src/main/haskell/Hydra/Parsing.hs +++ b/src/main/haskell/Hydra/Parsing.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Parser combinator types for text parsing module Hydra.Parsing where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | An error which occurred while parsing data ParseError = ParseError { @@ -13,9 +16,13 @@ -- | The remaining input at the point of failure parseErrorRemainder :: String} deriving (Eq, Ord, Read, Show) + _ParseError = Core.Name "hydra.parsing.ParseError" + _ParseError_message = Core.Name "message" + _ParseError_remainder = Core.Name "remainder" + -- | The result of a parse operation data ParseResult a = -- | A successful parse, with a value and the remaining unparsed input @@ -23,9 +30,13 @@ -- | A failed parse, with an error message and the remaining input ParseResultFailure ParseError deriving (Eq, Ord, Read, Show) + _ParseResult = Core.Name "hydra.parsing.ParseResult" + _ParseResult_success = Core.Name "success" + _ParseResult_failure = Core.Name "failure" + -- | A successful parse result data ParseSuccess a = ParseSuccess { @@ -34,11 +45,16 @@ -- | The remaining unparsed input parseSuccessRemainder :: String} deriving (Eq, Ord, Read, Show) + _ParseSuccess = Core.Name "hydra.parsing.ParseSuccess" + _ParseSuccess_value = Core.Name "value" + _ParseSuccess_remainder = Core.Name "remainder" + -- | A parser which consumes characters from a string and produces a value newtype Parser a = Parser { unParser :: (String -> ParseResult a)} + _Parser = Core.Name "hydra.parsing.Parser" diff --git a/src/main/haskell/Hydra/Paths.hs b/src/main/haskell/Hydra/Paths.hs --- a/src/main/haskell/Hydra/Paths.hs +++ b/src/main/haskell/Hydra/Paths.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model for subterm and subtype access patterns module Hydra.Paths where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | An edge in a subterm graph, connecting two nodes via a path data SubtermEdge = SubtermEdge { @@ -15,10 +18,15 @@ -- | The target node of the edge subtermEdgeTarget :: SubtermNode} deriving (Eq, Ord, Read, Show) + _SubtermEdge = Core.Name "hydra.paths.SubtermEdge" + _SubtermEdge_source = Core.Name "source" + _SubtermEdge_path = Core.Name "path" + _SubtermEdge_target = Core.Name "target" + -- | A graph of subterm nodes and edges, representing term access patterns data SubtermGraph = SubtermGraph { @@ -27,9 +35,13 @@ -- | All edges in the graph subtermGraphEdges :: [SubtermEdge]} deriving (Eq, Ord, Read, Show) + _SubtermGraph = Core.Name "hydra.paths.SubtermGraph" + _SubtermGraph_nodes = Core.Name "nodes" + _SubtermGraph_edges = Core.Name "edges" + -- | A node in a subterm graph, representing a term or subterm data SubtermNode = SubtermNode { @@ -40,16 +52,23 @@ -- | A unique identifier for the node subtermNodeId :: String} deriving (Eq, Ord, Read, Show) + _SubtermNode = Core.Name "hydra.paths.SubtermNode" + _SubtermNode_name = Core.Name "name" + _SubtermNode_label = Core.Name "label" + _SubtermNode_id = Core.Name "id" + -- | A sequence of subterm steps forming a path through a term newtype SubtermPath = SubtermPath { unSubtermPath :: [SubtermStep]} deriving (Eq, Ord, Read, Show) + _SubtermPath = Core.Name "hydra.paths.SubtermPath" + -- | A function which maps from a term to a particular immediate subterm data SubtermStep = -- | Access the body of an annotated term @@ -93,27 +112,49 @@ -- | Access the term inside a wrapped term SubtermStepWrappedTerm deriving (Eq, Ord, Read, Show) + _SubtermStep = Core.Name "hydra.paths.SubtermStep" + _SubtermStep_annotatedBody = Core.Name "annotatedBody" + _SubtermStep_applicationFunction = Core.Name "applicationFunction" + _SubtermStep_applicationArgument = Core.Name "applicationArgument" + _SubtermStep_lambdaBody = Core.Name "lambdaBody" + _SubtermStep_unionCasesDefault = Core.Name "unionCasesDefault" + _SubtermStep_unionCasesBranch = Core.Name "unionCasesBranch" + _SubtermStep_letBody = Core.Name "letBody" + _SubtermStep_letBinding = Core.Name "letBinding" + _SubtermStep_listElement = Core.Name "listElement" + _SubtermStep_mapKey = Core.Name "mapKey" + _SubtermStep_mapValue = Core.Name "mapValue" + _SubtermStep_optionalTerm = Core.Name "optionalTerm" + _SubtermStep_productTerm = Core.Name "productTerm" + _SubtermStep_recordField = Core.Name "recordField" + _SubtermStep_setElement = Core.Name "setElement" + _SubtermStep_sumTerm = Core.Name "sumTerm" + _SubtermStep_typeLambdaBody = Core.Name "typeLambdaBody" + _SubtermStep_typeApplicationTerm = Core.Name "typeApplicationTerm" + _SubtermStep_injectionTerm = Core.Name "injectionTerm" + _SubtermStep_wrappedTerm = Core.Name "wrappedTerm" + -- | An edge in a subtype graph, connecting two nodes via a path data SubtypeEdge = SubtypeEdge { @@ -124,10 +165,15 @@ -- | The target node of the edge subtypeEdgeTarget :: SubtypeNode} deriving (Eq, Ord, Read, Show) + _SubtypeEdge = Core.Name "hydra.paths.SubtypeEdge" + _SubtypeEdge_source = Core.Name "source" + _SubtypeEdge_path = Core.Name "path" + _SubtypeEdge_target = Core.Name "target" + -- | A graph of subtype nodes and edges, representing type access patterns data SubtypeGraph = SubtypeGraph { @@ -136,9 +182,13 @@ -- | All edges in the graph subtypeGraphEdges :: [SubtypeEdge]} deriving (Eq, Ord, Read, Show) + _SubtypeGraph = Core.Name "hydra.paths.SubtypeGraph" + _SubtypeGraph_nodes = Core.Name "nodes" + _SubtypeGraph_edges = Core.Name "edges" + -- | A node in a subtype graph, representing a type or subtype data SubtypeNode = SubtypeNode { @@ -149,16 +199,23 @@ -- | A unique identifier for the node subtypeNodeId :: String} deriving (Eq, Ord, Read, Show) + _SubtypeNode = Core.Name "hydra.paths.SubtypeNode" + _SubtypeNode_name = Core.Name "name" + _SubtypeNode_label = Core.Name "label" + _SubtypeNode_id = Core.Name "id" + -- | A sequence of subtype steps forming a path through a type newtype SubtypePath = SubtypePath { unSubtypePath :: [SubtypeStep]} deriving (Eq, Ord, Read, Show) + _SubtypePath = Core.Name "hydra.paths.SubtypePath" + -- | A function which maps from a type to a particular immediate subtype data SubtypeStep = -- | Access the body of an annotated type @@ -198,22 +255,41 @@ -- | Access the type inside a wrapped type SubtypeStepWrappedType deriving (Eq, Ord, Read, Show) + _SubtypeStep = Core.Name "hydra.paths.SubtypeStep" + _SubtypeStep_annotatedBody = Core.Name "annotatedBody" + _SubtypeStep_applicationFunction = Core.Name "applicationFunction" + _SubtypeStep_applicationArgument = Core.Name "applicationArgument" + _SubtypeStep_eitherLeft = Core.Name "eitherLeft" + _SubtypeStep_eitherRight = Core.Name "eitherRight" + _SubtypeStep_forallBody = Core.Name "forallBody" + _SubtypeStep_functionDomain = Core.Name "functionDomain" + _SubtypeStep_functionCodomain = Core.Name "functionCodomain" + _SubtypeStep_listElement = Core.Name "listElement" + _SubtypeStep_mapKeys = Core.Name "mapKeys" + _SubtypeStep_mapValues = Core.Name "mapValues" + _SubtypeStep_optionalElement = Core.Name "optionalElement" + _SubtypeStep_pairFirst = Core.Name "pairFirst" + _SubtypeStep_pairSecond = Core.Name "pairSecond" + _SubtypeStep_recordField = Core.Name "recordField" + _SubtypeStep_setElement = Core.Name "setElement" + _SubtypeStep_unionField = Core.Name "unionField" + _SubtypeStep_wrappedType = Core.Name "wrappedType" 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 @@ -1,29 +1,35 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Type and term classification predicates module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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 @@ -33,8 +39,10 @@ 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 @@ -44,6 +52,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Check if a binding needs to be treated as a function isComplexBinding :: Graph.Graph -> Core.Binding -> Bool isComplexBinding tc b = @@ -55,6 +64,7 @@ isNonNullary = Equality.gt (Arity.typeArity (Core.typeSchemeBody ts)) 0 isComplex = isComplexTerm tc term in (Logic.or (Logic.or isPolymorphic isNonNullary) isComplex))) + -- | Check if a term needs to be treated as a function rather than a simple value isComplexTerm :: Graph.Graph -> Core.Term -> Bool isComplexTerm tc t = @@ -64,6 +74,7 @@ Core.TermTypeLambda _ -> True Core.TermVariable v0 -> isComplexVariable tc v0 _ -> Lists.foldl (\b -> \sub -> Logic.or b (isComplexTerm tc sub)) False (Rewriting.subterms t) + -- | Check if a variable is bound to a complex term isComplexVariable :: Graph.Graph -> Core.Name -> Bool isComplexVariable tc name = @@ -74,6 +85,7 @@ 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))))) + -- | Determines whether a given term is an encoded term (meta-level term) isEncodedTerm :: Core.Term -> Bool isEncodedTerm t = @@ -81,6 +93,7 @@ Core.TermApplication v0 -> isEncodedTerm (Core.applicationFunction v0) Core.TermInject v0 -> Equality.equal "hydra.core.Term" (Core.unName (Core.injectionTypeName v0)) _ -> False + -- | Determines whether a given term is an encoded type isEncodedType :: Core.Term -> Bool isEncodedType t = @@ -88,16 +101,19 @@ Core.TermApplication v0 -> isEncodedType (Core.applicationFunction v0) Core.TermInject v0 -> Equality.equal "hydra.core.Type" (Core.unName (Core.injectionTypeName v0)) _ -> False + -- | Check if a row type represents an enum (all fields are unit-typed) isEnumRowType :: [Core.FieldType] -> Bool isEnumRowType rt = Lists.foldl Logic.and True (Lists.map (\f -> isUnitType (Strip.deannotateType (Core.fieldTypeType f))) rt) + -- | Check if a type is an enum type isEnumType :: Core.Type -> Bool isEnumType typ = case (Strip.deannotateType typ) of Core.TypeUnion v0 -> isEnumRowType v0 _ -> False + -- | Check whether a type is a nominal type definition (record, union, wrap, or forall wrapping one). Type aliases (applications, functions, literal types, etc.) return false. isNominalType :: Core.Type -> Bool isNominalType typ = @@ -107,6 +123,7 @@ Core.TypeWrap _ -> True Core.TypeForall v0 -> isNominalType (Core.forallTypeBody v0) _ -> False + -- | Check if an element is serializable (no function types in dependencies) (Either version) isSerializable :: t0 -> Graph.Graph -> Core.Binding -> Either Errors.Error Bool isSerializable cx graph el = @@ -115,7 +132,8 @@ \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 (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 Equality.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 isSerializableByName cx graph name = @@ -124,14 +142,16 @@ \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 (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 Equality.identity name)) + -- | Check if a type is serializable (no function types in the type itself) isSerializableType :: Core.Type -> Bool isSerializableType typ = let allVariants = Sets.fromList (Lists.map Reflect.typeVariant (Rewriting.foldOverType Coders.TraversalOrderPre (\m -> \t -> Lists.cons t m) [] typ)) - in (Logic.not (Sets.member Variants.TypeVariantFunction allVariants)) + in (Logic.not (Logic.or (Sets.member Variants.TypeVariantEffect allVariants) (Sets.member Variants.TypeVariantFunction allVariants))) + -- | Check if a term is trivially cheap (no thunking needed) isTrivialTerm :: Core.Term -> Bool isTrivialTerm t = @@ -152,6 +172,7 @@ Core.TermTypeApplication v0 -> isTrivialTerm (Core.typeApplicationTermBody v0) Core.TermTypeLambda v0 -> isTrivialTerm (Core.typeLambdaBody v0) _ -> False + -- | Check whether a type is a type (always true for non-encoded types) isType :: Core.Type -> Bool isType t = @@ -161,18 +182,21 @@ Core.TypeUnion _ -> False Core.TypeVariable v0 -> Equality.equal v0 (Core.Name "hydra.core.Type") _ -> False + -- | Check whether a term is the unit term isUnitTerm :: Core.Term -> Bool isUnitTerm x = case x of Core.TermUnit -> True _ -> False + -- | Check whether a type is the unit type isUnitType :: Core.Type -> Bool isUnitType x = case x of Core.TypeUnit -> True _ -> False + -- | Get all type dependencies for a given type name (Either version) typeDependencies :: t0 -> Graph.Graph -> Bool -> (Core.Type -> Core.Type) -> Core.Name -> Either Errors.Error (M.Map Core.Name Core.Type) typeDependencies cx graph withSchema transform name = diff --git a/src/main/haskell/Hydra/Query.hs b/src/main/haskell/Hydra/Query.hs --- a/src/main/haskell/Hydra/Query.hs +++ b/src/main/haskell/Hydra/Query.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model for language-agnostic graph pattern queries module Hydra.Query where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | One of several comparison operators data ComparisonConstraint = ComparisonConstraintEqual | @@ -14,13 +17,21 @@ ComparisonConstraintLessThanOrEqual | ComparisonConstraintGreaterThanOrEqual deriving (Eq, Ord, Read, Show) + _ComparisonConstraint = Core.Name "hydra.query.ComparisonConstraint" + _ComparisonConstraint_equal = Core.Name "equal" + _ComparisonConstraint_notEqual = Core.Name "notEqual" + _ComparisonConstraint_lessThan = Core.Name "lessThan" + _ComparisonConstraint_greaterThan = Core.Name "greaterThan" + _ComparisonConstraint_lessThanOrEqual = Core.Name "lessThanOrEqual" + _ComparisonConstraint_greaterThanOrEqual = Core.Name "greaterThanOrEqual" + -- | An abstract edge based on a record type data Edge = Edge { @@ -31,10 +42,15 @@ -- | The field representing the in-projection of the edge. Defaults to 'in'. edgeIn :: (Maybe Core.Name)} deriving (Eq, Ord, Read, Show) + _Edge = Core.Name "hydra.query.Edge" + _Edge_type = Core.Name "type" + _Edge_out = Core.Name "out" + _Edge_in = Core.Name "in" + -- | A query pattern which matches within a designated component subgraph data GraphPattern = GraphPattern { @@ -43,9 +59,13 @@ -- | The patterns to match within the subgraph graphPatternPatterns :: [Pattern]} deriving (Eq, Ord, Read, Show) + _GraphPattern = Core.Name "hydra.query.GraphPattern" + _GraphPattern_graph = Core.Name "graph" + _GraphPattern_patterns = Core.Name "patterns" + -- | A node in a query expression; it may be a term, a variable, or a wildcard data Node = -- | A graph term; an expression which is valid in the graph being matched @@ -55,10 +75,15 @@ -- | An anonymous variable which we do not care to join across patterns NodeWildcard deriving (Eq, Ord, Read, Show) + _Node = Core.Name "hydra.query.Node" + _Node_term = Core.Name "term" + _Node_variable = Core.Name "variable" + _Node_wildcard = Core.Name "wildcard" + -- | A query path data Path = -- | A path given by a single step @@ -68,10 +93,15 @@ -- | A path given by the inverse of another path PathInverse Path deriving (Eq, Ord, Read, Show) + _Path = Core.Name "hydra.query.Path" + _Path_step = Core.Name "step" + _Path_regex = Core.Name "regex" + _Path_inverse = Core.Name "inverse" + -- | A declared equivalence between two abstract paths in a graph data PathEquation = PathEquation { @@ -80,9 +110,13 @@ -- | The right-hand side of the equation pathEquationRight :: Path} deriving (Eq, Ord, Read, Show) + _PathEquation = Core.Name "hydra.query.PathEquation" + _PathEquation_left = Core.Name "left" + _PathEquation_right = Core.Name "right" + -- | A query pattern data Pattern = -- | A subject/predicate/object pattern @@ -96,12 +130,19 @@ -- | A pattern which matches within a named subgraph PatternGraph GraphPattern deriving (Eq, Ord, Read, Show) + _Pattern = Core.Name "hydra.query.Pattern" + _Pattern_triple = Core.Name "triple" + _Pattern_negation = Core.Name "negation" + _Pattern_conjunction = Core.Name "conjunction" + _Pattern_disjunction = Core.Name "disjunction" + _Pattern_graph = Core.Name "graph" + -- | A pattern which, if it matches in a given graph, implies that another pattern must also match. Query variables are shared between the two patterns. data PatternImplication = PatternImplication { @@ -110,9 +151,13 @@ -- | The pattern which must also match when the antecedent matches patternImplicationConsequent :: Pattern} deriving (Eq, Ord, Read, Show) + _PatternImplication = Core.Name "hydra.query.PatternImplication" + _PatternImplication_antecedent = Core.Name "antecedent" + _PatternImplication_consequent = Core.Name "consequent" + -- | A SELECT-style graph pattern matching query data Query = Query { @@ -121,9 +166,13 @@ -- | The patterns to be matched queryPatterns :: [Pattern]} deriving (Eq, Ord, Read, Show) + _Query = Core.Name "hydra.query.Query" + _Query_variables = Core.Name "variables" + _Query_patterns = Core.Name "patterns" + -- | A range from min to max, inclusive data Range = Range { @@ -132,9 +181,13 @@ -- | The maximum value (inclusive) rangeMax :: Int} deriving (Eq, Ord, Read, Show) + _Range = Core.Name "hydra.query.Range" + _Range_min = Core.Name "min" + _Range_max = Core.Name "max" + -- | A regular expression quantifier data RegexQuantifier = -- | No quantifier; matches a single occurrence @@ -152,14 +205,23 @@ -- | The {n, m} quantifier; matches between n and m (inclusive) occurrences RegexQuantifierRange Range deriving (Eq, Ord, Read, Show) + _RegexQuantifier = Core.Name "hydra.query.RegexQuantifier" + _RegexQuantifier_one = Core.Name "one" + _RegexQuantifier_zeroOrOne = Core.Name "zeroOrOne" + _RegexQuantifier_zeroOrMore = Core.Name "zeroOrMore" + _RegexQuantifier_oneOrMore = Core.Name "oneOrMore" + _RegexQuantifier_exactly = Core.Name "exactly" + _RegexQuantifier_atLeast = Core.Name "atLeast" + _RegexQuantifier_range = Core.Name "range" + -- | A path with a regex quantifier data RegexSequence = RegexSequence { @@ -168,9 +230,13 @@ -- | The quantifier regexSequenceQuantifier :: RegexQuantifier} deriving (Eq, Ord, Read, Show) + _RegexSequence = Core.Name "hydra.query.RegexSequence" + _RegexSequence_path = Core.Name "path" + _RegexSequence_quantifier = Core.Name "quantifier" + -- | An atomic function as part of a query. When applied to a graph, steps are typed by function types. data Step = -- | An out-to-in traversal of an abstract edge @@ -180,10 +246,15 @@ -- | A comparison of two terms StepCompare ComparisonConstraint deriving (Eq, Ord, Read, Show) + _Step = Core.Name "hydra.query.Step" + _Step_edge = Core.Name "edge" + _Step_project = Core.Name "project" + _Step_compare = Core.Name "compare" + -- | A subject/predicate/object pattern data TriplePattern = TriplePattern { @@ -194,13 +265,19 @@ -- | The object of the pattern triplePatternObject :: Node} deriving (Eq, Ord, Read, Show) + _TriplePattern = Core.Name "hydra.query.TriplePattern" + _TriplePattern_subject = Core.Name "subject" + _TriplePattern_predicate = Core.Name "predicate" + _TriplePattern_object = Core.Name "object" + -- | A query variable newtype Variable = Variable { unVariable :: String} deriving (Eq, Ord, Read, Show) + _Variable = Core.Name "hydra.query.Variable" diff --git a/src/main/haskell/Hydra/Read/Docs.hs b/src/main/haskell/Hydra/Read/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Read/Docs.hs @@ -0,0 +1,69 @@ +-- 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 @@ -1,35 +1,41 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Functions for reducing terms and types, i.e. performing computations. module Hydra.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.Encode.Core as EncodeCore 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -41,8 +47,10 @@ 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 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 @@ -52,9 +60,11 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Alpha convert a variable in a term alphaConvert :: Core.Name -> Core.Name -> Core.Term -> Core.Term alphaConvert vold vnew term = Variables.replaceFreeTermVariable vold (Core.TermVariable vnew) term + -- | Eagerly beta-reduce a type by substituting type arguments into type lambdas betaReduceType :: t0 -> Graph.Graph -> Core.Type -> Either Errors.Error Core.Type betaReduceType cx graph typ = @@ -81,6 +91,7 @@ _ -> Right r in (Eithers.bind (recurse t) (\r -> findApp r)) in (Rewriting.rewriteTypeM mapExpr typ) + -- | Apply the special rules: -- | ((\x.e1) e2) == e1, where x does not appear free in e1 -- | and @@ -104,9 +115,11 @@ _ -> rec _ -> rec in (Rewriting.rewriteTerm rewrite term) + -- | Compile-time flag controlling whether primitive invocations are counted during evaluation. For demo and instrumentation purposes. countPrimitiveInvocations :: Bool countPrimitiveInvocations = True + -- | Recursively transform terms to eliminate partial application, e.g. 'add 42' becomes '\x.add 42 x'. Uses the Graph to look up types for arity calculation. Bare primitives and variables are NOT expanded; eliminations and partial applications are. This version properly tracks the Graph through nested scopes. etaExpandTerm :: Graph.Graph -> Core.Term -> Core.Term etaExpandTerm tx0 term0 = @@ -312,6 +325,7 @@ Core.wrappedTermTypeName = (Core.wrappedTermTypeName v0), Core.wrappedTermBody = (recurse tx (Core.wrappedTermBody v0))})) in (contractTerm (rewriteWithArgs [] tx0 term0)) + -- | Recursively transform arbitrary terms like 'add 42' into terms like '\x.add 42 x', eliminating partial application. Variable references are not expanded. This is useful for targets like Python with weaker support for currying than Hydra or Haskell. Note: this is a "trusty" function which assumes the graph is well-formed, i.e. no dangling references. It also assumes that type inference has already been performed. After eta expansion, type inference needs to be performed again, as new, untyped lambdas may have been added. etaExpandTypedTerm :: Typing.InferenceContext -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term etaExpandTypedTerm cx tx0 term0 = @@ -422,6 +436,7 @@ in (recurse txt term) _ -> recurseOrForce term in (Rewriting.rewriteTermWithContextM (rewrite True False []) tx0 term0) + -- | Calculate the arity for eta expansion Note: this is a "trusty" function which assumes the graph is well-formed, i.e. no dangling references. etaExpansionArity :: Graph.Graph -> Core.Term -> Int etaExpansionArity graph term = @@ -436,6 +451,7 @@ Core.TermTypeApplication v0 -> etaExpansionArity graph (Core.typeApplicationTermBody v0) Core.TermVariable v0 -> Optionals.cases (Optionals.bind (Lexical.lookupBinding graph v0) (\b -> Core.bindingTypeScheme b)) 0 (\ts -> Arity.typeArity (Core.typeSchemeBody ts)) _ -> 0 + -- | Eta-reduce a term by removing redundant lambda abstractions etaReduceTerm :: Core.Term -> Core.Term etaReduceTerm term = @@ -470,6 +486,7 @@ Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v0)}) Core.TermLambda v0 -> reduceLambda v0 _ -> noChange + -- | A term evaluation function which is alternatively lazy or eager reduceTerm :: t0 -> Graph.Graph -> Bool -> Core.Term -> Either Errors.Error Core.Term reduceTerm cx graph eager term = @@ -570,9 +587,11 @@ mapping = \recurse -> \mid -> Eithers.bind (Logic.ifElse (doRecurse eager mid) (recurse mid) (Right mid)) (\inner -> applyIfNullary eager inner []) in (Rewriting.rewriteTermM mapping term) + -- | Whether a term is closed, i.e. represents a complete program termIsClosed :: Core.Term -> Bool termIsClosed term = Sets.null (Variables.freeVariablesInTerm term) + -- | Whether a term has been fully reduced to a value termIsValue :: Core.Term -> Bool termIsValue term = 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 @@ -1,24 +1,32 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Reflection functions for working with term, type, and literal type variants, as well as numeric precision. module Hydra.Reflect 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.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists 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 @@ -27,24 +35,28 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Find the precision of a given floating-point type floatTypePrecision :: Core.FloatType -> Util.Precision floatTypePrecision x = case x of Core.FloatTypeFloat32 -> Util.PrecisionBits 32 Core.FloatTypeFloat64 -> Util.PrecisionBits 64 + -- | All floating-point types in a canonical order floatTypes :: [Core.FloatType] floatTypes = [ Core.FloatTypeFloat32, Core.FloatTypeFloat64] + -- | Find the float type for a given floating-point value floatValueType :: Core.FloatValue -> Core.FloatType floatValueType x = case x of Core.FloatValueFloat32 _ -> Core.FloatTypeFloat32 Core.FloatValueFloat64 _ -> Core.FloatTypeFloat64 + -- | Find whether a given integer type is signed (true) or unsigned (false) integerTypeIsSigned :: Core.IntegerType -> Bool integerTypeIsSigned x = @@ -58,6 +70,7 @@ Core.IntegerTypeUint16 -> False Core.IntegerTypeUint32 -> False Core.IntegerTypeUint64 -> False + -- | Find the precision of a given integer type integerTypePrecision :: Core.IntegerType -> Util.Precision integerTypePrecision x = @@ -71,6 +84,7 @@ Core.IntegerTypeUint16 -> Util.PrecisionBits 16 Core.IntegerTypeUint32 -> Util.PrecisionBits 32 Core.IntegerTypeUint64 -> Util.PrecisionBits 64 + -- | All integer types, in a canonical order integerTypes :: [Core.IntegerType] integerTypes = @@ -84,6 +98,7 @@ Core.IntegerTypeUint16, Core.IntegerTypeUint32, Core.IntegerTypeUint64] + -- | Find the integer type for a given integer value integerValueType :: Core.IntegerValue -> Core.IntegerType integerValueType x = @@ -97,6 +112,7 @@ Core.IntegerValueUint16 _ -> Core.IntegerTypeUint16 Core.IntegerValueUint32 _ -> Core.IntegerTypeUint32 Core.IntegerValueUint64 _ -> Core.IntegerTypeUint64 + -- | Find the literal type for a given literal value literalType :: Core.Literal -> Core.LiteralType literalType x = @@ -107,6 +123,7 @@ Core.LiteralFloat v0 -> (\injected_ -> Core.LiteralTypeFloat injected_) (floatValueType v0) Core.LiteralInteger v0 -> (\injected_ -> Core.LiteralTypeInteger injected_) (integerValueType v0) Core.LiteralString _ -> Core.LiteralTypeString + -- | Find the literal type inject (constructor) for a given literal value literalTypeVariant :: Core.LiteralType -> Variants.LiteralVariant literalTypeVariant x = @@ -117,6 +134,7 @@ Core.LiteralTypeFloat _ -> Variants.LiteralVariantFloat Core.LiteralTypeInteger _ -> Variants.LiteralVariantInteger Core.LiteralTypeString -> Variants.LiteralVariantString + -- | All literal types, in a canonical order literalTypes :: [Core.LiteralType] literalTypes = @@ -129,9 +147,11 @@ (Lists.map (\x -> Core.LiteralTypeInteger x) integerTypes), [ Core.LiteralTypeString]] + -- | Find the literal inject (constructor) for a given literal value literalVariant :: Core.Literal -> Variants.LiteralVariant literalVariant arg_ = literalTypeVariant (literalType arg_) + -- | All literal variants, in a canonical order literalVariants :: [Variants.LiteralVariant] literalVariants = @@ -142,6 +162,7 @@ Variants.LiteralVariantFloat, Variants.LiteralVariantInteger, Variants.LiteralVariantString] + -- | Find the term inject (constructor) for a given term termVariant :: Core.Term -> Variants.TermVariant termVariant x = @@ -167,6 +188,7 @@ Core.TermUnwrap _ -> Variants.TermVariantUnwrap Core.TermVariable _ -> Variants.TermVariantVariable Core.TermWrap _ -> Variants.TermVariantWrap + -- | All term (expression) variants, in a canonical order termVariants :: [Variants.TermVariant] termVariants = @@ -192,15 +214,17 @@ Variants.TermVariantUnwrap, Variants.TermVariantVariable, Variants.TermVariantWrap] + -- | Find the type inject (constructor) for a given type typeVariant :: Core.Type -> Variants.TypeVariant typeVariant x = case x of Core.TypeAnnotated _ -> Variants.TypeVariantAnnotated Core.TypeApplication _ -> Variants.TypeVariantApplication + Core.TypeEffect _ -> Variants.TypeVariantEffect Core.TypeEither _ -> Variants.TypeVariantEither - Core.TypeFunction _ -> Variants.TypeVariantFunction Core.TypeForall _ -> Variants.TypeVariantForall + Core.TypeFunction _ -> Variants.TypeVariantFunction Core.TypeList _ -> Variants.TypeVariantList Core.TypeLiteral _ -> Variants.TypeVariantLiteral Core.TypeMap _ -> Variants.TypeVariantMap @@ -213,19 +237,20 @@ Core.TypeVariable _ -> Variants.TypeVariantVariable Core.TypeVoid -> Variants.TypeVariantVoid Core.TypeWrap _ -> Variants.TypeVariantWrap + -- | All type variants, in a canonical order typeVariants :: [Variants.TypeVariant] typeVariants = [ Variants.TypeVariantAnnotated, Variants.TypeVariantApplication, + Variants.TypeVariantEffect, Variants.TypeVariantEither, - Variants.TypeVariantFunction, Variants.TypeVariantForall, + Variants.TypeVariantFunction, Variants.TypeVariantList, Variants.TypeVariantLiteral, Variants.TypeVariantMap, - Variants.TypeVariantWrap, Variants.TypeVariantOptional, Variants.TypeVariantPair, Variants.TypeVariantRecord, @@ -233,4 +258,5 @@ Variants.TypeVariantUnion, Variants.TypeVariantUnit, Variants.TypeVariantVariable, - Variants.TypeVariantVoid] + Variants.TypeVariantVoid, + Variants.TypeVariantWrap] diff --git a/src/main/haskell/Hydra/Relational.hs b/src/main/haskell/Hydra/Relational.hs --- a/src/main/haskell/Hydra/Relational.hs +++ b/src/main/haskell/Hydra/Relational.hs @@ -1,18 +1,23 @@ -- Note: this is an automatically generated file. Do not edit. + -- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized. module Hydra.Relational 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 import qualified Data.Set as S + -- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd newtype ColumnName = ColumnName { unColumnName :: String} deriving (Eq, Ord, Read, Show) + _ColumnName = Core.Name "hydra.relational.ColumnName" + -- | An abstract specification of the domain represented by a column in a relation; a role data ColumnSchema t = ColumnSchema { @@ -21,9 +26,13 @@ -- | The domain (type) of the column columnSchemaDomain :: t} deriving (Eq, Ord, Read, Show) + _ColumnSchema = Core.Name "hydra.relational.ColumnSchema" + _ColumnSchema_name = Core.Name "name" + _ColumnSchema_domain = Core.Name "domain" + -- | A mapping from certain columns of a source relation to primary key columns of a target relation data ForeignKey = ForeignKey { @@ -32,27 +41,37 @@ -- | The mapping of source column names to target column names. The target column names must together make up the primary key of the target relation. foreignKeyKeys :: (M.Map ColumnName ColumnName)} deriving (Eq, Ord, Read, Show) + _ForeignKey = Core.Name "hydra.relational.ForeignKey" + _ForeignKey_foreignRelation = Core.Name "foreignRelation" + _ForeignKey_keys = Core.Name "keys" + -- | A primary key of a relation, specified either as a single column, or as a list of columns newtype PrimaryKey = PrimaryKey { unPrimaryKey :: [ColumnName]} deriving (Eq, Ord, Read, Show) + _PrimaryKey = Core.Name "hydra.relational.PrimaryKey" + -- | A set of distinct n-tuples; a table newtype Relation v = Relation { unRelation :: [Row v]} deriving (Eq, Ord, Read, Show) + _Relation = Core.Name "hydra.relational.Relation" + -- | A unique relation (table) name newtype RelationName = RelationName { unRelationName :: String} deriving (Eq, Ord, Read, Show) + _RelationName = Core.Name "hydra.relational.RelationName" + -- | An abstract relation; the name and columns of a relation without its actual data data RelationSchema t = RelationSchema { @@ -65,20 +84,29 @@ -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation relationSchemaForeignKeys :: [ForeignKey]} deriving (Eq, Ord, Read, Show) + _RelationSchema = Core.Name "hydra.relational.RelationSchema" + _RelationSchema_name = Core.Name "name" + _RelationSchema_columns = Core.Name "columns" + _RelationSchema_primaryKeys = Core.Name "primaryKeys" + _RelationSchema_foreignKeys = Core.Name "foreignKeys" + -- | A domain-unordered (string-indexed, rather than position-indexed) relation newtype Relationship v = Relationship { unRelationship :: (S.Set (M.Map ColumnName v))} deriving (Eq, Ord, Read, Show) + _Relationship = Core.Name "hydra.relational.Relationship" + -- | An n-tuple which is an element of a given relation newtype Row v = Row { unRow :: [v]} deriving (Eq, Ord, Read, Show) + _Row = Core.Name "hydra.relational.Row" 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 @@ -1,28 +1,34 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Type dereference, lookup, requirements, and instantiation module Hydra.Resolution 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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -33,8 +39,10 @@ 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 +import qualified Hydra.Time as Time import qualified Hydra.Topology as Topology import qualified Hydra.Typed as Typed import qualified Hydra.Typing as Typing @@ -45,6 +53,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Dereference a type name to get the actual type (Either version) dereferenceType :: t0 -> Graph.Graph -> Core.Name -> Either Errors.Error (Maybe Core.Type) dereferenceType cx graph name = @@ -53,6 +62,7 @@ in (Optionals.cases mel (Right Nothing) (\el -> Eithers.map Optionals.pure (Eithers.bimap (\_e -> Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "type", Errors.unexpectedShapeErrorActual = (Errors.unDecodingError _e)}))) (\_a -> _a) (DecodeCore.type_ graph (Core.bindingTerm el))))) + -- | Test whether a given System F type is polymorphic (i.e., a forall type) fTypeIsPolymorphic :: Core.Type -> Bool fTypeIsPolymorphic typ = @@ -60,18 +70,21 @@ Core.TypeAnnotated v0 -> fTypeIsPolymorphic (Core.annotatedTypeBody v0) Core.TypeForall _ -> True _ -> False + -- | Build a map from field name to field term, given a list of fields fieldMap :: [Core.Field] -> M.Map Core.Name Core.Term fieldMap fields = let toPair = \f -> (Core.fieldName f, (Core.fieldTerm f)) in (Maps.fromList (Lists.map toPair fields)) + -- | Build a map from field name to field type, given a list of field types fieldTypeMap :: [Core.FieldType] -> M.Map Core.Name Core.Type fieldTypeMap fields = let toPair = \f -> (Core.fieldTypeName f, (Core.fieldTypeType f)) in (Maps.fromList (Lists.map toPair fields)) + -- | Get field types from a record or union type (Either version) fieldTypes :: t0 -> Graph.Graph -> Core.Type -> Either Errors.Error (M.Map Core.Name Core.Type) fieldTypes cx graph t = @@ -87,6 +100,7 @@ _ -> Left (Errors.ErrorResolution (Errors.ResolutionErrorUnexpectedShape (Errors.UnexpectedShapeError { Errors.unexpectedShapeErrorExpected = "record or union type", Errors.unexpectedShapeErrorActual = (ShowCore.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 findFieldType cx fname fields = @@ -97,6 +111,7 @@ 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 { Errors.multipleFieldsErrorFieldName = fname})))))) + -- | Fully strip a type of forall quantifiers, normalizing bound variable names for alpha-equivalence comparison fullyStripAndNormalizeType :: Core.Type -> Core.Type fullyStripAndNormalizeType typ = @@ -112,18 +127,21 @@ subst = Pairs.first result body = Pairs.second result in (Variables.substituteTypeVariables subst body) + -- | Fully strip a type of forall quantifiers fullyStripType :: Core.Type -> Core.Type fullyStripType typ = case (Strip.deannotateType typ) of Core.TypeForall v0 -> fullyStripType (Core.forallTypeBody v0) _ -> typ + -- | Instantiate a type by replacing all forall-bound type variables with fresh variables, threading InferenceContext instantiateType :: Typing.InferenceContext -> Core.Type -> (Core.Type, Typing.InferenceContext) instantiateType cx typ = let result = instantiateTypeScheme cx (typeToTypeScheme typ) in (Scoping.typeSchemeToFType (Pairs.first result), (Pairs.second result)) + -- | Instantiate a type scheme with fresh variables, threading InferenceContext instantiateTypeScheme :: Typing.InferenceContext -> Core.TypeScheme -> (Core.TypeScheme, Typing.InferenceContext) instantiateTypeScheme cx scheme = @@ -142,12 +160,14 @@ Core.typeSchemeBody = (Substitution.substInType subst (Core.typeSchemeBody scheme)), Core.typeSchemeConstraints = renamedConstraints}, cx2) + -- | Apply type arguments to a nominal type nominalApplication :: Core.Name -> [Core.Type] -> Core.Type nominalApplication tname args = Lists.foldl (\t -> \a -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = t, Core.applicationTypeArgument = a})) (Core.TypeVariable tname) args + -- | Require a name to resolve to a record type requireRecordType :: t0 -> Graph.Graph -> Core.Name -> Either Errors.Error [Core.FieldType] requireRecordType cx graph name = @@ -157,6 +177,7 @@ Core.TypeRecord v0 -> Just v0 _ -> Nothing in (requireRowType cx "record type" toRecord graph name) + -- | Require a name to resolve to a row type requireRowType :: t0 -> String -> (Core.Type -> Maybe t1) -> Graph.Graph -> Core.Name -> Either Errors.Error t1 requireRowType cx label getter graph name = @@ -169,16 +190,19 @@ 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))) + -- | 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) requireSchemaType cx types tname = Optionals.cases (Maps.lookup tname types) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchBinding (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = tname})))) (\ts -> Right (instantiateTypeScheme cx (Strip.deannotateTypeSchemeRecursive ts))) + -- | Require a type by name requireType :: t0 -> Graph.Graph -> Core.Name -> Either Errors.Error Core.Type requireType cx graph name = Optionals.cases (Maps.lookup name (Graph.graphSchemaTypes graph)) (Optionals.cases (Maps.lookup name (Graph.graphBoundTypes graph)) (Left (Errors.ErrorResolution (Errors.ResolutionErrorNoSuchBinding (Errors.NoSuchBindingError { Errors.noSuchBindingErrorName = name})))) (\ts -> Right (Scoping.typeSchemeToFType ts))) (\ts -> Right (Scoping.typeSchemeToFType ts)) + -- | Require a field type from a union type requireUnionField :: t0 -> Graph.Graph -> Core.Name -> Core.Name -> Either Errors.Error Core.Type requireUnionField cx graph tname fname = @@ -190,6 +214,7 @@ Errors.noMatchingFieldErrorFieldName = fname}))) in (Optionals.cases (Lists.find (\ft -> Equality.equal (Core.fieldTypeName ft) fname) rt) noMatchErr (\ft -> Right (Core.fieldTypeType ft))) in (Eithers.bind (requireUnionType cx graph tname) withRowType) + -- | Require a name to resolve to a union type requireUnionType :: t0 -> Graph.Graph -> Core.Name -> Either Errors.Error [Core.FieldType] requireUnionType cx graph name = @@ -199,12 +224,14 @@ Core.TypeUnion v0 -> Just v0 _ -> Nothing in (requireRowType cx "union" toUnion graph name) + -- | Resolve a type, dereferencing type variables resolveType :: Graph.Graph -> Core.Type -> Maybe Core.Type resolveType graph typ = case (Strip.deannotateType typ) of Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 (Graph.graphSchemaTypes graph)) (Optionals.map (\ts -> Scoping.typeSchemeToFType ts) (Maps.lookup v0 (Graph.graphBoundTypes graph))) (\ts -> Just (Scoping.typeSchemeToFType ts)) _ -> Just typ + -- | Convert a (System F -style) type to a type scheme typeToTypeScheme :: Core.Type -> Core.TypeScheme typeToTypeScheme t0 = 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 @@ -1,31 +1,39 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Core rewrite and fold combinators for terms and types module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists +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.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.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 @@ -34,6 +42,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Apply a term-level function inside any leading type lambdas applyInsideTypeLambdasAndAnnotations :: (Core.Term -> Core.Term) -> Core.Term -> Core.Term applyInsideTypeLambdasAndAnnotations f term0 = @@ -45,18 +54,21 @@ Core.typeLambdaParameter = (Core.typeLambdaParameter v0), Core.typeLambdaBody = (applyInsideTypeLambdasAndAnnotations f (Core.typeLambdaBody v0))}) _ -> f term0 + -- | Fold over a term, traversing its subterms in the specified order foldOverTerm :: Coders.TraversalOrder -> (t0 -> Core.Term -> t0) -> t0 -> Core.Term -> t0 foldOverTerm order fld b0 term = case order of Coders.TraversalOrderPre -> Lists.foldl (foldOverTerm order fld) (fld b0 term) (subterms term) Coders.TraversalOrderPost -> fld (Lists.foldl (foldOverTerm order fld) b0 (subterms term)) term + -- | Fold over a type, traversing its subtypes in the specified order foldOverType :: Coders.TraversalOrder -> (t0 -> Core.Type -> t0) -> t0 -> Core.Type -> t0 foldOverType order fld b0 typ = case order of Coders.TraversalOrderPre -> Lists.foldl (foldOverType order fld) (fld b0 typ) (subtypes typ) Coders.TraversalOrderPost -> fld (Lists.foldl (foldOverType order fld) b0 (subtypes typ)) typ + -- | Fold over a term to produce a value, with both Graph and accessor path tracked. Like rewriteAndFoldTermWithGraphAndPath, but only folds without rewriting. The Graph is automatically updated when descending into lambdas, lets, and type lambdas. foldTermWithGraphAndPath :: ((t0 -> Core.Term -> t0) -> [Paths.SubtermStep] -> Graph.Graph -> t0 -> Core.Term -> t0) -> Graph.Graph -> t0 -> Core.Term -> t0 foldTermWithGraphAndPath f cx0 val0 term0 = @@ -70,6 +82,7 @@ in (f recurseForUser path cx val term, term) result = rewriteAndFoldTermWithGraphAndPath wrapper cx0 val0 term0 in (Pairs.first result) + -- | Apply a transformation to the first type beneath a chain of annotations mapBeneathTypeAnnotations :: (Core.Type -> Core.Type) -> Core.Type -> Core.Type mapBeneathTypeAnnotations f t = @@ -78,6 +91,7 @@ Core.annotatedTypeBody = (mapBeneathTypeAnnotations f (Core.annotatedTypeBody v0)), Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v0)}) _ -> f t + -- | Rewrite a term, and at the same time, fold a function over it, accumulating a value rewriteAndFoldTerm :: ((t0 -> Core.Term -> (t0, Core.Term)) -> t0 -> Core.Term -> (t0, Core.Term)) -> t0 -> Core.Term -> (t0, Core.Term) rewriteAndFoldTerm f term0 = @@ -198,6 +212,7 @@ _ -> dflt recurse = f (fsub recurse) in (recurse term0) + -- | Rewrite a term while folding to produce a value, with Graph updated as we descend into subterms. Combines the features of rewriteAndFoldTerm and rewriteTermWithGraph. The user function f receives a recurse function that handles subterm traversal and Graph management. rewriteAndFoldTermWithGraph :: ((t0 -> Core.Term -> (t0, Core.Term)) -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term)) -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term) rewriteAndFoldTermWithGraph f cx0 val0 term0 = @@ -220,6 +235,7 @@ in ((Pairs.first fResult, cx), (Pairs.second fResult)) result = rewriteAndFoldTerm wrapper (val0, cx0) term0 in (Pairs.first (Pairs.first result), (Pairs.second result)) + -- | Rewrite a term while folding to produce a value, with both Graph and accessor path tracked. The path is a list of SubtermSteps representing the position from the root to the current term. Combines the features of rewriteAndFoldTermWithPath and Graph tracking. The Graph is automatically updated when descending into lambdas, lets, and type lambdas. rewriteAndFoldTermWithGraphAndPath :: ((t0 -> Core.Term -> (t0, Core.Term)) -> [Paths.SubtermStep] -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term)) -> Graph.Graph -> t0 -> Core.Term -> (t0, Core.Term) rewriteAndFoldTermWithGraphAndPath f cx0 val0 term0 = @@ -242,6 +258,7 @@ in ((cx, (Pairs.first fResult)), (Pairs.second fResult)) result = rewriteAndFoldTermWithPath wrapper (cx0, val0) term0 in (Pairs.second (Pairs.first result), (Pairs.second result)) + -- | Rewrite a term with path tracking, and fold a function over it, accumulating a value. The path is a list of SubtermSteps from root to current position. rewriteAndFoldTermWithPath :: (([Paths.SubtermStep] -> t0 -> Core.Term -> (t0, Core.Term)) -> [Paths.SubtermStep] -> t0 -> Core.Term -> (t0, Core.Term)) -> t0 -> Core.Term -> (t0, Core.Term) rewriteAndFoldTermWithPath f term0 = @@ -409,6 +426,7 @@ _ -> dflt recurse = f (fsub recurse) in (recurse [] term0) + -- | Rewrite a term with a custom transformation function. The function receives a recursive walker and the current term and decides whether to recurse, replace, or both. rewriteTerm :: ((Core.Term -> Core.Term) -> Core.Term -> Core.Term) -> Core.Term -> Core.Term rewriteTerm f term0 = @@ -481,6 +499,7 @@ Core.wrappedTermBody = (recurse (Core.wrappedTermBody v0))}) recurse = f (fsub recurse) in (recurse term0) + -- | Either-based term rewriting with custom transformation function rewriteTermM :: ((Core.Term -> Either t0 Core.Term) -> Core.Term -> Either t0 Core.Term) -> Core.Term -> Either t0 Core.Term rewriteTermM f term0 = @@ -571,6 +590,7 @@ Core.wrappedTermBody = rt})))) recurse = f (fsub recurse) in (recurse term0) + -- | A variant of rewriteTerm which allows a context (e.g. a TypeContext) to be passed down to all subterms during rewriting rewriteTermWithContext :: ((t0 -> Core.Term -> Core.Term) -> t0 -> Core.Term -> Core.Term) -> t0 -> Core.Term -> Core.Term rewriteTermWithContext f cx0 term0 = @@ -644,6 +664,7 @@ Core.wrappedTermBody = (recurse (Core.wrappedTermBody v0))}) rewrite = \cx -> \term -> f (forSubterms rewrite) cx term in (rewrite cx0 term0) + -- | Either-based variant of rewriteTermWithContextM which allows a context (e.g. a TypeContext) to be passed down to all subterms during rewriting rewriteTermWithContextM :: ((t0 -> Core.Term -> Either t1 Core.Term) -> t0 -> Core.Term -> Either t1 Core.Term) -> t0 -> Core.Term -> Either t1 Core.Term rewriteTermWithContextM f cx0 term0 = @@ -735,6 +756,7 @@ Core.wrappedTermBody = rt})))) rewrite = \cx -> \term -> f (forSubterms rewrite) cx term in (rewrite cx0 term0) + -- | Rewrite a term with the help of a Graph which is updated as we descend into subterms rewriteTermWithGraph :: ((Core.Term -> t0) -> Graph.Graph -> Core.Term -> t0) -> Graph.Graph -> Core.Term -> t0 rewriteTermWithGraph f cx0 term0 = @@ -758,6 +780,7 @@ _ -> f recurse1 cx term rewrite = \cx -> \term -> f2 rewrite cx term in (rewrite cx0 term0) + -- | Rewrite a type with a custom transformation function. The function receives a recursive walker and the current type and decides whether to recurse, replace, or both. rewriteType :: ((Core.Type -> Core.Type) -> Core.Type -> Core.Type) -> Core.Type -> Core.Type rewriteType f typ0 = @@ -775,6 +798,7 @@ Core.TypeApplication v0 -> Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = (recurse (Core.applicationTypeFunction v0)), Core.applicationTypeArgument = (recurse (Core.applicationTypeArgument v0))}) + Core.TypeEffect v0 -> Core.TypeEffect (recurse v0) Core.TypeEither v0 -> Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = (recurse (Core.eitherTypeLeft v0)), Core.eitherTypeRight = (recurse (Core.eitherTypeRight v0))}) @@ -802,6 +826,7 @@ Core.TypeWrap v0 -> Core.TypeWrap (recurse v0) recurse = f (fsub recurse) in (recurse typ0) + -- | Either-based type rewriting rewriteTypeM :: ((Core.Type -> Either t0 Core.Type) -> Core.Type -> Either t0 Core.Type) -> Core.Type -> Either t0 Core.Type rewriteTypeM f typ0 = @@ -814,6 +839,7 @@ Core.TypeApplication v0 -> Eithers.bind (recurse (Core.applicationTypeFunction v0)) (\lhs -> Eithers.bind (recurse (Core.applicationTypeArgument v0)) (\rhs -> Right (Core.TypeApplication (Core.ApplicationType { Core.applicationTypeFunction = lhs, Core.applicationTypeArgument = rhs})))) + Core.TypeEffect v0 -> Eithers.bind (recurse v0) (\rt -> Right (Core.TypeEffect rt)) Core.TypeEither v0 -> Eithers.bind (recurse (Core.eitherTypeLeft v0)) (\left -> Eithers.bind (recurse (Core.eitherTypeRight v0)) (\right -> Right (Core.TypeEither (Core.EitherType { Core.eitherTypeLeft = left, Core.eitherTypeRight = right})))) @@ -851,6 +877,7 @@ Core.TypeWrap v0 -> Eithers.bind (recurse v0) (\t -> Right (Core.TypeWrap t)) recurse = f (fsub recurse) in (recurse typ0) + -- | Find the children of a given term subterms :: Core.Term -> [Core.Term] subterms x = @@ -892,6 +919,7 @@ Core.TermVariable _ -> [] Core.TermWrap v0 -> [ Core.wrappedTermBody v0] + -- | Find the children of a given term subtermsWithSteps :: Core.Term -> [(Paths.SubtermStep, Core.Term)] subtermsWithSteps x = @@ -929,6 +957,7 @@ Core.TermVariable _ -> [] Core.TermWrap v0 -> [ (Paths.SubtermStepWrappedTerm, (Core.wrappedTermBody v0))] + -- | Find the children of a given type expression subtypes :: Core.Type -> [Core.Type] subtypes x = @@ -938,6 +967,8 @@ Core.TypeApplication v0 -> [ Core.applicationTypeFunction v0, (Core.applicationTypeArgument v0)] + Core.TypeEffect v0 -> [ + v0] Core.TypeEither v0 -> [ Core.eitherTypeLeft v0, (Core.eitherTypeRight 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 @@ -1,32 +1,40 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Graph context extension and type scheme conversion module Hydra.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.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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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 @@ -35,6 +43,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Extend a graph by descending into a lambda body extendGraphForLambda :: Graph.Graph -> Core.Lambda -> Graph.Graph extendGraphForLambda g lam = @@ -49,6 +58,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives g), Graph.graphSchemaTypes = (Graph.graphSchemaTypes g), Graph.graphTypeVariables = (Graph.graphTypeVariables g)} + -- | Extend a graph by descending into a let body extendGraphForLet :: (Graph.Graph -> Core.Binding -> Maybe Core.Term) -> Graph.Graph -> Core.Let -> Graph.Graph extendGraphForLet forBinding g letrec = @@ -75,6 +85,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives g), Graph.graphSchemaTypes = (Graph.graphSchemaTypes g), Graph.graphTypeVariables = (Graph.graphTypeVariables g)} + -- | Extend a graph by descending into a type lambda body extendGraphForTypeLambda :: Graph.Graph -> Core.TypeLambda -> Graph.Graph extendGraphForTypeLambda g tlam = @@ -89,6 +100,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives g), Graph.graphSchemaTypes = (Graph.graphSchemaTypes g), Graph.graphTypeVariables = (Sets.insert name (Graph.graphTypeVariables g))} + -- | Add bindings to an existing graph extendGraphWithBindings :: [Core.Binding] -> Graph.Graph -> Graph.Graph extendGraphWithBindings bindings g = @@ -105,6 +117,7 @@ Graph.graphPrimitives = (Graph.graphPrimitives g), Graph.graphSchemaTypes = (Graph.graphSchemaTypes g), Graph.graphTypeVariables = (Graph.graphTypeVariables g)} + -- | Convert a forall type to a type scheme fTypeToTypeScheme :: Core.Type -> Core.TypeScheme fTypeToTypeScheme typ = @@ -121,6 +134,7 @@ Core.typeSchemeBody = typ2, Core.typeSchemeConstraints = Nothing} in (gatherForall [] typ) + -- | Convert a TermSignature to a TypeScheme, erasing parameter names, descriptions, and laziness flags. termSignatureToTypeScheme :: Typing.TermSignature -> Core.TypeScheme termSignatureToTypeScheme sig = @@ -144,6 +158,7 @@ Core.typeSchemeVariables = variables, Core.typeSchemeBody = body, Core.typeSchemeConstraints = constraints} + -- | Convert a type scheme to a forall type typeSchemeToFType :: Core.TypeScheme -> Core.Type typeSchemeToFType ts = @@ -153,6 +168,7 @@ in (Lists.foldl (\t -> \v -> Core.TypeForall (Core.ForallType { Core.forallTypeParameter = v, Core.forallTypeBody = t})) body (Lists.reverse vars)) + -- | Convert a TypeScheme to a TermSignature. Type variables and class constraints are preserved exactly. Value-parameter names are synthesized as arg0, arg1, .... Per-parameter descriptions are nothing and isLazy defaults to false. typeSchemeToTermSignature :: Core.TypeScheme -> Typing.TermSignature typeSchemeToTermSignature ts = 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 @@ -1,31 +1,39 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Utilities for constructing generic program code ASTs, used for the serialization phase of source code generation. module Hydra.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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +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.Math as Math +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.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 @@ -34,25 +42,31 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Angle bracket pair `<` `>` for use with `brackets` angleBraces :: Ast.Brackets angleBraces = Ast.Brackets { Ast.bracketsOpen = (Ast.Symbol "<"), Ast.bracketsClose = (Ast.Symbol ">")} + -- | Comma-separate the elements inside angle brackets in the given block style; renders as `<>` when empty angleBracesList :: Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr angleBracesList style els = Logic.ifElse (Lists.null els) (cst "<>") (brackets angleBraces style (commaSep style els)) + -- | Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression. bracesListAdaptive :: [Ast.Expr] -> Ast.Expr bracesListAdaptive els = chooseLayout maxLineWidth (curlyBracesList Nothing inlineStyle els) (curlyBracesList Nothing halfBlockStyle els) + -- | Comma-separate the elements inside square brackets in the given block style; renders as `[]` when empty bracketList :: Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr bracketList style els = Logic.ifElse (Lists.null els) (cst "[]") (brackets squareBrackets style (commaSep style els)) + -- | Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression. bracketListAdaptive :: [Ast.Expr] -> Ast.Expr bracketListAdaptive els = chooseLayout maxLineWidth (bracketList inlineStyle els) (bracketList halfBlockStyle els) + -- | Wrap an expression in the given bracket pair using the given block style brackets :: Ast.Brackets -> Ast.BlockStyle -> Ast.Expr -> Ast.Expr brackets br style e = @@ -60,37 +74,46 @@ Ast.bracketExprBrackets = br, Ast.bracketExprEnclosed = e, Ast.bracketExprStyle = style}) + -- | 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 + -- | Separate elements with a comma, using the given block style commaSep :: Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr commaSep = symbolSep "," + -- | Comma-separate elements inline if the joined width fits, otherwise break onto separate lines. commaSepAdaptive :: [Ast.Expr] -> Ast.Expr commaSepAdaptive els = chooseLayout maxLineWidth (commaSep inlineStyle els) (commaSep halfBlockStyle els) + -- | Construct a constant expression from a literal string cst :: String -> Ast.Expr cst s = Ast.ExprConst (sym s) + -- | Wrap a single expression in curly braces using the given block style curlyBlock :: Ast.BlockStyle -> Ast.Expr -> Ast.Expr curlyBlock style e = curlyBracesList Nothing style [ e] + -- | Curly brace pair `{` `}` for use with `brackets` curlyBraces :: Ast.Brackets curlyBraces = Ast.Brackets { Ast.bracketsOpen = (Ast.Symbol "{"), Ast.bracketsClose = (Ast.Symbol "}")} + -- | 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)) + -- | 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))) + -- | 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 customIndentBlock idt els = @@ -104,6 +127,7 @@ 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))))) + -- | Separate elements with a dot and no surrounding whitespace dotSep :: [Ast.Expr] -> Ast.Expr dotSep = @@ -114,6 +138,7 @@ Ast.paddingRight = Ast.WsNone}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | Separate elements with a blank line between them doubleNewlineSep :: [Ast.Expr] -> Ast.Expr doubleNewlineSep = @@ -124,9 +149,11 @@ Ast.paddingRight = Ast.WsBreak}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | The two-space string used as the canonical indent unit doubleSpace :: String doubleSpace = " " + -- | Find the approximate length (number of characters, including spaces and newlines) of an expression without actually printing it. expressionLength :: Ast.Expr -> Int expressionLength e = @@ -183,6 +210,7 @@ Ast.ExprOp v0 -> opExprLength v0 Ast.ExprBrackets v0 -> bracketExprLength v0 Ast.ExprSeq v0 -> seqExprLength v0 + -- | Block style with double-space indent and newlines both before and after the bracketed content fullBlockStyle :: Ast.BlockStyle fullBlockStyle = @@ -190,6 +218,7 @@ Ast.blockStyleIndent = (Just doubleSpace), Ast.blockStyleNewlineBeforeContent = True, Ast.blockStyleNewlineAfterContent = True} + -- | Block style with double-space indent, a newline before the content but not after halfBlockStyle :: Ast.BlockStyle halfBlockStyle = @@ -197,6 +226,7 @@ Ast.blockStyleIndent = (Just doubleSpace), Ast.blockStyleNewlineBeforeContent = True, Ast.blockStyleNewlineAfterContent = False} + -- | Build an infix expression with the given operator and two operands ifx :: Ast.Op -> Ast.Expr -> Ast.Expr -> Ast.Expr ifx op lhs rhs = @@ -204,18 +234,22 @@ Ast.opExprOp = op, Ast.opExprLhs = lhs, Ast.opExprRhs = rhs}) + -- | Indent every non-empty line of a string by `doubleSpace` indent :: String -> String indent = customIndent doubleSpace + -- | Like `customIndentBlock`, but using `doubleSpace` as the indent prefix indentBlock :: [Ast.Expr] -> Ast.Expr indentBlock = customIndentBlock doubleSpace + -- | Indent every line of an expression except the first by the given prefix indentSubsequentLines :: String -> Ast.Expr -> Ast.Expr indentSubsequentLines idt e = Ast.ExprIndent (Ast.IndentedExpression { Ast.indentedExpressionStyle = (Ast.IndentStyleSubsequentLines idt), Ast.indentedExpressionExpr = e}) + -- | Space-separate three elements: left operand, operator string, right operand infixWs :: String -> Ast.Expr -> Ast.Expr -> Ast.Expr infixWs op l r = @@ -223,6 +257,7 @@ l, (cst op), r] + -- | Space-separate operands interleaved with the given operator string infixWsList :: String -> [Ast.Expr] -> Ast.Expr infixWsList op opers = @@ -231,6 +266,7 @@ foldFun = \e -> \r -> Logic.ifElse (Lists.null e) [ r] (Lists.cons r (Lists.cons opExpr e)) in (spaceSep (Lists.foldl foldFun [] (Lists.reverse opers))) + -- | Block style with no indent and no surrounding newlines: contents stay on a single line inlineStyle :: Ast.BlockStyle inlineStyle = @@ -238,9 +274,11 @@ Ast.blockStyleIndent = Nothing, Ast.blockStyleNewlineBeforeContent = False, Ast.blockStyleNewlineAfterContent = False} + -- | The canonical maximum line width used by Hydra writers. Adaptive helpers compare estimated expression widths against this threshold to decide whether to render inline or break across lines. Set to 120 to match the project-wide line-length convention. maxLineWidth :: Int maxLineWidth = 120 + -- | Separate elements by a newline (no leading whitespace) newlineSep :: [Ast.Expr] -> Ast.Expr newlineSep = @@ -251,12 +289,14 @@ Ast.paddingRight = Ast.WsBreak}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | Operator padding with no whitespace on either side noPadding :: Ast.Padding noPadding = Ast.Padding { Ast.paddingLeft = Ast.WsNone, Ast.paddingRight = Ast.WsNone} + -- | Concatenate elements with no separator and no whitespace noSep :: [Ast.Expr] -> Ast.Expr noSep = @@ -267,9 +307,11 @@ Ast.paddingRight = Ast.WsNone}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | Construct a constant expression from an int32 num :: Int -> Ast.Expr num i = cst (Literals.showInt32 i) + -- | Build an op with single-space padding from a symbol, precedence, and associativity op :: String -> Int -> Ast.Associativity -> Ast.Op op s p assoc = @@ -280,6 +322,7 @@ Ast.paddingRight = Ast.WsSpace}, Ast.opPrecedence = (Ast.Precedence p), Ast.opAssociativity = assoc} + -- | Build the `|` alternative-separator operator. The flag selects whether the right side breaks onto a new line. orOp :: Bool -> Ast.Op orOp newlines = @@ -290,30 +333,36 @@ Ast.paddingRight = (Logic.ifElse newlines Ast.WsBreak Ast.WsSpace)}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} + -- | Separate alternatives with `|`, breaking onto separate lines when the block style requests a newline before content orSep :: Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr 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))) + -- | 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 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. parenListAdaptive :: [Ast.Expr] -> Ast.Expr parenListAdaptive els = chooseLayout maxLineWidth (parenList False els) (parenList True els) + -- | Wrap an expression in inline parentheses parens :: Ast.Expr -> Ast.Expr parens = brackets parentheses inlineStyle + -- | Round parenthesis pair `(` `)` for use with `brackets` parentheses :: Ast.Brackets parentheses = Ast.Brackets { Ast.bracketsOpen = (Ast.Symbol "("), Ast.bracketsClose = (Ast.Symbol ")")} + -- | Recursively insert parentheses around subexpressions where required by operator precedence and associativity. The traversal descends into bracket, indent, sequence, and operator expressions and parenthesizes left or right operands whose binding is weaker than the surrounding operator. parenthesize :: Ast.Expr -> Ast.Expr parenthesize exp = @@ -374,6 +423,7 @@ Ast.opExprOp = op, Ast.opExprLhs = lhs2, Ast.opExprRhs = rhs2})) + -- | Prepend a prefix string to an expression with no surrounding whitespace prefix :: String -> Ast.Expr -> Ast.Expr prefix p expr = @@ -387,6 +437,7 @@ Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} in (ifx preOp (cst "") expr) + -- | Render an expression to a string, expanding bracket pairs, block styles, indents, and operator chains printExpr :: Ast.Expr -> String printExpr e = @@ -461,7 +512,13 @@ Ast.WsBreakAndIndent _ -> True Ast.WsDoubleBreak -> True _ -> False - padlEffective = Logic.ifElse (Logic.and (Equality.equal sym "") (Logic.or padrIsNewline (Equality.equal rhs ""))) "" (pad padl) + padlIsNewline = + case padl of + Ast.WsBreak -> True + Ast.WsDoubleBreak -> True + _ -> False + 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) padrEffective = Logic.ifElse (Logic.and rhsStartsWithNewline (Logic.not padrIsNewline)) "" padrPad @@ -480,13 +537,16 @@ pre = Logic.ifElse nlBefore "\n" "" suf = Logic.ifElse nlAfter "\n" "" in (Strings.cat2 (Strings.cat2 (Strings.cat2 (Strings.cat2 l pre) ibody) suf) r) + -- | Separate elements with `;` inline semicolonSep :: [Ast.Expr] -> Ast.Expr semicolonSep = symbolSep ";" inlineStyle + -- | 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)) + -- | Space-separate elements (no break between them) spaceSep :: [Ast.Expr] -> Ast.Expr spaceSep = @@ -497,21 +557,25 @@ Ast.paddingRight = Ast.WsNone}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | Space-separate elements inline if the joined width fits, otherwise newline-separate them. Useful for long signatures, type chains, and other space-joined sequences. spaceSepAdaptive :: [Ast.Expr] -> Ast.Expr spaceSepAdaptive els = chooseLayout maxLineWidth (spaceSep els) (newlineSep els) + -- | Square bracket pair `[` `]` for use with `brackets` squareBrackets :: Ast.Brackets squareBrackets = Ast.Brackets { Ast.bracketsOpen = (Ast.Symbol "["), Ast.bracketsClose = (Ast.Symbol "]")} + -- | 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 { Ast.seqExprOp = op, Ast.seqExprElements = els}))) + -- | Like spaceSep, but produces a SeqExpr. Use for structural layout that should not trigger parenthesization of children. structuralSpaceSep :: [Ast.Expr] -> Ast.Expr structuralSpaceSep = @@ -522,6 +586,7 @@ Ast.paddingRight = Ast.WsNone}, Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone}) + -- | Append a suffix string to an expression suffix :: String -> Ast.Expr -> Ast.Expr suffix s expr = @@ -535,9 +600,11 @@ Ast.opPrecedence = (Ast.Precedence 0), Ast.opAssociativity = Ast.AssociativityNone} in (ifx sufOp expr (cst "")) + -- | Construct a Symbol from a string sym :: String -> Ast.Symbol sym s = Ast.Symbol s + -- | Separate elements with the given symbol; trailing whitespace per element is determined by the block style's newline-before/after flags (space, single break, or double break) symbolSep :: String -> Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr symbolSep symb style l = @@ -557,31 +624,38 @@ 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))) + -- | Indent every line of an expression by four spaces tabIndent :: Ast.Expr -> Ast.Expr tabIndent e = Ast.ExprIndent (Ast.IndentedExpression { Ast.indentedExpressionStyle = (Ast.IndentStyleAllLines " "), Ast.indentedExpressionExpr = e}) + -- | Tab-indent a list of expressions, separated by blank lines tabIndentDoubleSpace :: [Ast.Expr] -> Ast.Expr tabIndentDoubleSpace exprs = tabIndent (doubleNewlineSep exprs) + -- | Tab-indent a list of expressions, separated by single newlines tabIndentSingleSpace :: [Ast.Expr] -> Ast.Expr tabIndentSingleSpace exprs = tabIndent (newlineSep exprs) + -- | 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) "]") + -- | 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)) "]") + -- | Append a trailing comma to an expression withComma :: Ast.Expr -> Ast.Expr withComma e = noSep [ e, (cst ",")] + -- | Append a trailing semicolon to an expression withSemi :: Ast.Expr -> Ast.Expr withSemi e = diff --git a/src/main/haskell/Hydra/Show/Core.hs b/src/main/haskell/Hydra/Show/Core.hs --- a/src/main/haskell/Hydra/Show/Core.hs +++ b/src/main/haskell/Hydra/Show/Core.hs @@ -1,32 +1,40 @@ -- 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -37,6 +45,7 @@ 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 = @@ -53,6 +62,7 @@ typeStr, " = ", (term t)]) + -- | Show a case statement as a string caseStatement :: Core.CaseStatement -> String caseStatement cs = @@ -78,10 +88,12 @@ 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 = @@ -92,6 +104,7 @@ fname, "=", (term fterm)]) + -- | Show a field type as a string fieldType :: Core.FieldType -> String fieldType ft = @@ -102,6 +115,7 @@ fname, ":", (type_ ftyp)]) + -- | Show a list of fields as a string fields :: [Core.Field] -> String fields flds = @@ -111,18 +125,21 @@ "{", (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 = @@ -135,6 +152,7 @@ ")", (fields [ f])]) + -- | Show an integer value as a string integer :: Core.IntegerValue -> String integer iv = @@ -148,6 +166,7 @@ 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 = @@ -161,6 +180,7 @@ Core.IntegerTypeUint16 -> "uint16" Core.IntegerTypeUint32 -> "uint32" Core.IntegerTypeUint64 -> "uint64" + -- | Show a lambda as a string lambda :: Core.Lambda -> String lambda l = @@ -175,6 +195,7 @@ typeStr, ".", (term body)]) + -- | Show a let expression as a string let_ :: Core.Let -> String let_ l = @@ -187,6 +208,7 @@ (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 = @@ -196,6 +218,7 @@ "[", (Strings.intercalate ", " elementStrs), "]"]) + -- | Show a literal as a string literal :: Core.Literal -> String literal l = @@ -206,6 +229,7 @@ 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 = @@ -216,6 +240,7 @@ 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 = @@ -229,9 +254,11 @@ "{", (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 = @@ -241,6 +268,7 @@ ", ", (showB (Pairs.second p)), ")"] + -- | Show a projection as a string projection :: Core.Projection -> String projection proj = @@ -253,9 +281,11 @@ "){", 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 = @@ -265,6 +295,7 @@ "{", (Strings.intercalate ", " elementStrs), "}"]) + -- | Show a term as a string term :: Core.Term -> String term t = @@ -367,6 +398,7 @@ "){", (term term1), "}"]) + -- | Show a type as a string type_ :: Core.Type -> String type_ typ = @@ -401,6 +433,10 @@ "(", (Strings.intercalate " @ " typeStrs), ")"]) + Core.TypeEffect v0 -> Strings.cat [ + "effect<", + (type_ v0), + ">"] Core.TypeEither v0 -> let leftTyp = Core.eitherTypeLeft v0 rightTyp = Core.eitherTypeRight v0 @@ -466,6 +502,7 @@ "wrap(", (type_ v0), ")"] + -- | Show a type scheme as a string typeScheme :: Core.TypeScheme -> String typeScheme ts = diff --git a/src/main/haskell/Hydra/Show/Docs.hs b/src/main/haskell/Hydra/Show/Docs.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Show/Docs.hs @@ -0,0 +1,87 @@ +-- 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 --- a/src/main/haskell/Hydra/Show/Error/Core.hs +++ b/src/main/haskell/Hydra/Show/Error/Core.hs @@ -1,18 +1,24 @@ -- 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.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -20,8 +26,10 @@ 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 @@ -30,78 +38,94 @@ 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 = @@ -128,6 +152,7 @@ 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 = @@ -146,72 +171,85 @@ 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 = @@ -224,36 +262,42 @@ "\" 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 = @@ -265,6 +309,7 @@ (ShowVariants.termVariant expected), " term but found ", (ShowCore.term actual)]) + -- | Show an unexpected type variant error as a string unexpectedTypeVariantError :: ErrorCore.UnexpectedTypeVariantError -> String unexpectedTypeVariantError e = @@ -276,21 +321,25 @@ (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 --- a/src/main/haskell/Hydra/Show/Error/Packaging.hs +++ b/src/main/haskell/Hydra/Show/Error/Packaging.hs @@ -1,25 +1,33 @@ -- 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.Haskell.Lib.Strings as Strings +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 @@ -28,6 +36,7 @@ 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 = @@ -36,6 +45,7 @@ (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 = @@ -49,6 +59,7 @@ " 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 = @@ -57,6 +68,7 @@ (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 = @@ -67,6 +79,7 @@ (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 = @@ -75,12 +88,14 @@ (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 = @@ -91,6 +106,7 @@ (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 = @@ -102,6 +118,7 @@ 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 = @@ -109,6 +126,7 @@ "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 = @@ -117,6 +135,7 @@ 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 = @@ -124,6 +143,7 @@ "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 = diff --git a/src/main/haskell/Hydra/Show/Errors.hs b/src/main/haskell/Hydra/Show/Errors.hs --- a/src/main/haskell/Hydra/Show/Errors.hs +++ b/src/main/haskell/Hydra/Show/Errors.hs @@ -1,21 +1,27 @@ -- 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -25,8 +31,10 @@ 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 @@ -35,6 +43,7 @@ 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 = @@ -49,9 +58,11 @@ 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 = @@ -70,12 +81,14 @@ 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 = @@ -89,15 +102,18 @@ (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 = @@ -111,6 +127,7 @@ (Errors.unexpectedShapeErrorExpected v0), " but got ", (Errors.unexpectedShapeErrorActual v0)] + -- | Show a type arity mismatch error as a string typeArityMismatchError :: Checking.TypeArityMismatchError -> String typeArityMismatchError e = @@ -128,6 +145,7 @@ (Literals.showInt32 actual), "): ", (Formatting.showList ShowCore.type_ args)]) + -- | Show a type mismatch error as a string typeMismatchError :: Checking.TypeMismatchError -> String typeMismatchError e = @@ -139,6 +157,7 @@ (ShowCore.type_ expected), " but found ", (ShowCore.type_ actual)]) + -- | Show an unbound type variables error as a string unboundTypeVariablesError :: Checking.UnboundTypeVariablesError -> String unboundTypeVariablesError e = @@ -150,6 +169,7 @@ (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 = @@ -161,6 +181,7 @@ (Formatting.showList ShowCore.type_ types), " in ", desc]) + -- | Show a unification error as a string unificationError :: Errors.UnificationError -> String unificationError e = @@ -175,13 +196,16 @@ (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 = diff --git a/src/main/haskell/Hydra/Show/Graph.hs b/src/main/haskell/Hydra/Show/Graph.hs --- a/src/main/haskell/Hydra/Show/Graph.hs +++ b/src/main/haskell/Hydra/Show/Graph.hs @@ -1,26 +1,34 @@ -- 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -29,6 +37,7 @@ 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 = diff --git a/src/main/haskell/Hydra/Show/Paths.hs b/src/main/haskell/Hydra/Show/Paths.hs --- a/src/main/haskell/Hydra/Show/Paths.hs +++ b/src/main/haskell/Hydra/Show/Paths.hs @@ -1,22 +1,28 @@ -- 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -24,8 +30,10 @@ 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 @@ -35,6 +43,7 @@ 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 = @@ -62,6 +71,7 @@ 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 = @@ -88,7 +98,7 @@ currentNodes = Pairs.first currentNodesVisited currentVisited = Pairs.second currentNodesVisited rawLabel = Names.compactName namespaces name - uniqueLabel = Names.uniqueLabel currentVisited rawLabel + uniqueLabel = Names.chooseUniqueLabel currentVisited rawLabel node = Paths.SubtermNode { Paths.subtermNodeName = name, diff --git a/src/main/haskell/Hydra/Show/Typing.hs b/src/main/haskell/Hydra/Show/Typing.hs --- a/src/main/haskell/Hydra/Show/Typing.hs +++ b/src/main/haskell/Hydra/Show/Typing.hs @@ -1,28 +1,36 @@ -- 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +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 @@ -31,6 +39,7 @@ 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 = @@ -41,6 +50,7 @@ ShowCore.type_ ltyp, "\8801", (ShowCore.type_ rtyp)]) + -- | Show a type substitution as a string typeSubst :: Typing.TypeSubst -> String typeSubst ts = diff --git a/src/main/haskell/Hydra/Show/Util.hs b/src/main/haskell/Hydra/Show/Util.hs --- a/src/main/haskell/Hydra/Show/Util.hs +++ b/src/main/haskell/Hydra/Show/Util.hs @@ -1,14 +1,20 @@ -- 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 @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ 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 = @@ -34,6 +43,7 @@ Util.CaseConventionUpperSnake -> "UPPER_SNAKE_CASE" Util.CaseConventionCamel -> "camelCase" Util.CaseConventionPascal -> "PascalCase" + -- | Show a comparison result as a string comparison :: Util.Comparison -> String comparison c = diff --git a/src/main/haskell/Hydra/Show/Variants.hs b/src/main/haskell/Hydra/Show/Variants.hs --- a/src/main/haskell/Hydra/Show/Variants.hs +++ b/src/main/haskell/Hydra/Show/Variants.hs @@ -1,14 +1,20 @@ -- 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 @@ -16,8 +22,10 @@ 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 @@ -26,6 +34,7 @@ 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 = @@ -51,12 +60,14 @@ 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" 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 @@ -1,32 +1,40 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Utilities for sorting. This module includes an implementation of Tarjan's algorithm, originally based on GraphSCC by Iavor S. Diatchki: https://hackage.haskell.org/package/GraphSCC. Tarjan was chosen because it computes strongly connected components in O(V+E), in a single pass, and yields the components in reverse topological order — exactly the shape every consumer in the kernel (HM let-generalization, schema graph construction, target-language emission) needs. module Hydra.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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +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.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.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.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 @@ -37,6 +45,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Convert an adjacency list to a map, concatenating values for duplicate keys adjacencyListToMap :: Ord t0 => ([(t0, [t1])] -> M.Map t0 [t1]) adjacencyListToMap pairs = @@ -45,6 +54,7 @@ vs = Pairs.second p existing = Optionals.cases (Maps.lookup k mp) [] Equality.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 = @@ -71,6 +81,7 @@ in (v, (Optionals.mapOptional (\k -> Maps.lookup k keyToVertex) neighbors))) indexedEdges) vertexToKey = \v -> Maps.lookup v vertexMap in (graph, vertexToKey) + -- | Construct an OrderingIsomorphism between two orderings of the same elements. The two list arguments must be permutations of each other; the result is a pair of mappings that transport an element list from one ordering to the other. createOrderingIsomorphism :: Ord t0 => ([t0] -> [t0] -> Topology.OrderingIsomorphism t1) createOrderingIsomorphism sourceOrd targetOrd = @@ -86,6 +97,7 @@ in Topology.OrderingIsomorphism { Topology.orderingIsomorphismEncode = sourceToTargetMapping, Topology.orderingIsomorphismDecode = targetToSourceMapping} + -- | Given an adjacency function and a distinguished root node, find all reachable nodes (including the root node) findReachableNodes :: Ord t0 => ((t0 -> S.Set t0) -> t0 -> S.Set t0) findReachableNodes adj root = @@ -95,6 +107,7 @@ let toVisit = Sets.difference (adj node) visited in (Logic.ifElse (Sets.null toVisit) visited (Lists.foldl (\v -> \n -> visit (Sets.insert n v) n) visited (Sets.toList toVisit))) in (visit (Sets.singleton root) root) + -- | Initial state for Tarjan's algorithm initialState :: Topology.TarjanState initialState = @@ -105,6 +118,7 @@ Topology.tarjanStateStack = [], Topology.tarjanStateOnStack = Sets.empty, Topology.tarjanStateSccs = []} + -- | Pop vertices off the stack until the given vertex is reached, collecting the current strongly connected component popStackUntil :: Int -> Topology.TarjanState -> ([Int], Topology.TarjanState) popStackUntil v st0 = @@ -132,6 +146,7 @@ acc_ = Lists.cons x acc in (Logic.ifElse (Equality.equal x v) (Lists.reverse acc_, newSt2) (go acc_ newSt2))) in (go [] st0) + -- | Given a graph as an adjacency list of edges and a list of explicit tags per node, compute the full set of tags for each node by propagating tags through edges. If there is an edge from n1 to n2 and n2 has tag t, then n1 also has tag t. Note: pairs in the output are not ordered. propagateTags :: (Ord t0, Ord t1) => ([(t0, [t0])] -> [(t0, [t1])] -> [(t0, (S.Set t1))]) propagateTags edges nodeTags = @@ -144,6 +159,7 @@ 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))) in (Lists.map (\n -> (n, (getTagsForNode n))) allNodes) + -- | Visit a vertex and recursively explore its successors strongConnect :: M.Map Int [Int] -> Int -> Topology.TarjanState -> Topology.TarjanState strongConnect graph v st = @@ -196,6 +212,7 @@ Topology.tarjanStateStack = (Topology.tarjanStateStack stPopped), Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack stPopped), Topology.tarjanStateSccs = (Lists.cons comp (Topology.tarjanStateSccs stPopped))}) stAfterNeighbors) + -- | Compute the strongly connected components of the given graph. The components are returned in reverse topological order stronglyConnectedComponents :: M.Map Int [Int] -> [[Int]] stronglyConnectedComponents graph = @@ -204,6 +221,7 @@ finalState = Lists.foldl (\st -> \v -> Logic.ifElse (Maps.member v (Topology.tarjanStateIndices st)) st (strongConnect graph v st)) initialState verts in (Lists.reverse (Lists.map Lists.sort (Topology.tarjanStateSccs finalState))) + -- | Sort a directed acyclic graph (DAG) based on an adjacency list. Yields a list of nontrivial strongly connected components if the graph has cycles, otherwise a simple list. topologicalSort :: Ord t0 => ([(t0, [t0])] -> Either [[t0]] [t0]) topologicalSort pairs = @@ -212,6 +230,7 @@ isCycle = \scc -> Equality.gt (Lists.length scc) 1 withCycles = Lists.filter isCycle sccs in (Logic.ifElse (Lists.null withCycles) (Right (Lists.concat sccs)) (Left withCycles)) + -- | Find the strongly connected components (including cycles and isolated vertices) of a graph, in (reverse) topological order, i.e. dependencies before dependents topologicalSortComponents :: Ord t0 => ([(t0, [t0])] -> [[t0]]) topologicalSortComponents pairs = @@ -219,6 +238,7 @@ let graphResult = adjacencyListsToGraph pairs g = Pairs.first graphResult in (Lists.map (\comp -> Optionals.mapOptional (Pairs.second graphResult) comp) (stronglyConnectedComponents g)) + -- | Sort a directed acyclic graph (DAG) of nodes using two helper functions: one for node keys, and one for the adjacency list of connected node keys. The result is a list of strongly-connected components (cycles), in which singleton lists represent acyclic nodes. topologicalSortNodes :: Ord t1 => ((t0 -> t1) -> (t0 -> [t1]) -> [t0] -> [[t0]]) topologicalSortNodes getKey getAdj nodes = 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 @@ -1,25 +1,33 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Annotation and type stripping and normalization module Hydra.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.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.Haskell.Lib.Lists as Lists +import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists 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 @@ -28,6 +36,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Strip type annotations from the top levels of a term deannotateAndDetypeTerm :: Core.Term -> Core.Term deannotateAndDetypeTerm t = @@ -36,24 +45,28 @@ Core.TermTypeApplication v0 -> deannotateAndDetypeTerm (Core.typeApplicationTermBody v0) Core.TermTypeLambda v0 -> deannotateAndDetypeTerm (Core.typeLambdaBody v0) _ -> t + -- | Strip all annotations (including System F type annotations) from the top levels of a term deannotateTerm :: Core.Term -> Core.Term deannotateTerm t = case t of Core.TermAnnotated v0 -> deannotateTerm (Core.annotatedTermBody v0) _ -> t + -- | Strip all annotations from a term deannotateType :: Core.Type -> Core.Type deannotateType t = case t of Core.TypeAnnotated v0 -> deannotateType (Core.annotatedTypeBody v0) _ -> t + -- | Strip any top-level type lambdas from a type, extracting the (possibly nested) type body deannotateTypeParameters :: Core.Type -> Core.Type deannotateTypeParameters t = case (deannotateType t) of Core.TypeForall v0 -> deannotateTypeParameters (Core.forallTypeBody v0) _ -> t + -- | Recursively strip all annotations from a type deannotateTypeRecursive :: Core.Type -> Core.Type deannotateTypeRecursive typ = @@ -65,6 +78,7 @@ Core.TypeAnnotated v0 -> Core.annotatedTypeBody v0 _ -> rewritten in (Rewriting.rewriteType strip typ) + -- | Recursively strip all annotations from a type scheme deannotateTypeSchemeRecursive :: Core.TypeScheme -> Core.TypeScheme deannotateTypeSchemeRecursive ts = @@ -76,6 +90,7 @@ Core.typeSchemeVariables = vars, Core.typeSchemeBody = (deannotateTypeRecursive typ), Core.typeSchemeConstraints = constraints} + -- | Strip System F type annotations from the top levels of a term, but leave application-specific annotations intact detypeTerm :: Core.Term -> Core.Term detypeTerm t = @@ -89,6 +104,7 @@ Core.TermTypeApplication v0 -> deannotateAndDetypeTerm (Core.typeApplicationTermBody v0) Core.TermTypeLambda v0 -> deannotateAndDetypeTerm (Core.typeLambdaBody v0) _ -> t + -- | Recursively remove term annotations, including within subterms removeTermAnnotations :: Core.Term -> Core.Term removeTermAnnotations term = @@ -100,6 +116,7 @@ Core.TermAnnotated v0 -> Core.annotatedTermBody v0 _ -> rewritten in (Rewriting.rewriteTerm remove term) + -- | Recursively remove type annotations, including within subtypes removeTypeAnnotations :: Core.Type -> Core.Type removeTypeAnnotations typ = @@ -111,6 +128,7 @@ Core.TypeAnnotated v0 -> Core.annotatedTypeBody v0 _ -> rewritten in (Rewriting.rewriteType remove typ) + -- | Strip type annotations (TypeLambda, TypeApplication, binding type schemes) from terms while preserving lambda domain types and other annotations removeTypeAnnotationsFromTerm :: Core.Term -> Core.Term removeTypeAnnotationsFromTerm term = @@ -131,6 +149,7 @@ Core.TermTypeLambda v0 -> Core.typeLambdaBody v0 _ -> rewritten in (Rewriting.rewriteTerm strip term) + -- | Strip type annotations from terms while preserving other annotations removeTypesFromTerm :: Core.Term -> Core.Term removeTypesFromTerm term = @@ -155,6 +174,7 @@ Core.TermTypeLambda v0 -> Core.typeLambdaBody v0 _ -> rewritten in (Rewriting.rewriteTerm strip term) + -- | Strip outer type lambda wrappers from a term, preserving type application wrappers and annotations stripTypeLambdas :: Core.Term -> Core.Term stripTypeLambdas t = 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 @@ -1,30 +1,38 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Variable substitution in type and term expressions. module Hydra.Substitution 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.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +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.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.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 @@ -35,13 +43,16 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Compose two type substitutions composeTypeSubst :: Typing.TypeSubst -> Typing.TypeSubst -> Typing.TypeSubst composeTypeSubst s1 s2 = Logic.ifElse (Maps.null (Typing.unTypeSubst s1)) s2 (Logic.ifElse (Maps.null (Typing.unTypeSubst s2)) s1 (composeTypeSubstNonEmpty s1 s2)) + -- | Compose a list of type substitutions composeTypeSubstList :: [Typing.TypeSubst] -> Typing.TypeSubst composeTypeSubstList = Lists.foldl composeTypeSubst idTypeSubst + -- | Compose two non-empty type substitutions (internal helper) composeTypeSubstNonEmpty :: Typing.TypeSubst -> Typing.TypeSubst -> Typing.TypeSubst composeTypeSubstNonEmpty s1 s2 = @@ -49,12 +60,15 @@ let isExtra = \k -> \v -> Optionals.isNone (Maps.lookup k (Typing.unTypeSubst s1)) withExtra = Maps.filterWithKey isExtra (Typing.unTypeSubst s2) in (Typing.TypeSubst (Maps.union withExtra (Maps.map (substInType s2) (Typing.unTypeSubst s1)))) + -- | The identity type substitution idTypeSubst :: Typing.TypeSubst idTypeSubst = Typing.TypeSubst Maps.empty + -- | Create a type substitution with a single variable mapping singletonTypeSubst :: Core.Name -> Core.Type -> Typing.TypeSubst singletonTypeSubst v t = Typing.TypeSubst (Maps.singleton v t) + -- | Apply a type substitution to class constraints, propagating to free variables substInClassConstraints :: Typing.TypeSubst -> M.Map Core.Name Core.TypeVariableConstraints -> M.Map Core.Name Core.TypeVariableConstraints substInClassConstraints subst constraints = @@ -72,6 +86,7 @@ in (Optionals.cases (Maps.lookup varName substMap) (insertOrMerge varName metadata acc) (\targetType -> let freeVars = Sets.toList (Variables.freeVariablesInType targetType) in (Lists.foldl (\acc2 -> \freeVar -> insertOrMerge freeVar metadata acc2) acc freeVars)))) Maps.empty (Maps.toList constraints)) + -- | Apply a type substitution to a graph's bound types and class constraints substInContext :: Typing.TypeSubst -> Graph.Graph -> Graph.Graph substInContext subst cx = @@ -97,9 +112,11 @@ Graph.graphPrimitives = (Graph.graphPrimitives cx2), Graph.graphSchemaTypes = (Graph.graphSchemaTypes cx2), Graph.graphTypeVariables = (Graph.graphTypeVariables cx2)} + -- | Apply a type substitution to a type substInType :: Typing.TypeSubst -> Core.Type -> Core.Type substInType subst typ0 = Logic.ifElse (Maps.null (Typing.unTypeSubst subst)) typ0 (substInTypeNonEmpty subst typ0) + -- | Apply a non-empty type substitution to a type (internal helper) substInTypeNonEmpty :: Typing.TypeSubst -> Core.Type -> Core.Type substInTypeNonEmpty subst typ0 = @@ -113,6 +130,7 @@ _ -> recurse typ removeVar = \v -> Typing.TypeSubst (Maps.delete v (Typing.unTypeSubst subst)) in (Rewriting.rewriteType rewrite typ0) + -- | Apply a type substitution to a type scheme. The scheme's quantifier variables shadow the substitution: any name in typeSchemeVariables is removed from subst before substituting into the body and constraints. Without this, a substitution like {t0 -> Foo} applied to `forall [t0]. t0 -> t0` would incorrectly replace the bound t0. substInTypeScheme :: Typing.TypeSubst -> Core.TypeScheme -> Core.TypeScheme substInTypeScheme subst ts = @@ -123,6 +141,7 @@ Core.typeSchemeVariables = (Core.typeSchemeVariables ts), Core.typeSchemeBody = (substInType scopedSubst (Core.typeSchemeBody ts)), Core.typeSchemeConstraints = (Optionals.map (substInClassConstraints scopedSubst) (Core.typeSchemeConstraints ts))} + -- | Apply a type substitution to the type annotations within a term substTypesInTerm :: Typing.TypeSubst -> Core.Term -> Core.Term substTypesInTerm subst term0 = @@ -163,6 +182,7 @@ Core.TermTypeLambda v0 -> forTypeLambda v0 _ -> dflt in (Rewriting.rewriteTerm rewrite term0) + -- | Apply a term substitution to a binding substituteInBinding :: Typing.TermSubst -> Core.Binding -> Core.Binding substituteInBinding subst b = @@ -170,6 +190,7 @@ Core.bindingName = (Core.bindingName b), Core.bindingTerm = (substituteInTerm subst (Core.bindingTerm b)), Core.bindingTypeScheme = (Core.bindingTypeScheme b)} + -- | Apply a type substitution to a type constraint substituteInConstraint :: Typing.TypeSubst -> Typing.TypeConstraint -> Typing.TypeConstraint substituteInConstraint subst c = @@ -177,9 +198,11 @@ Typing.typeConstraintLeft = (substInType subst (Typing.typeConstraintLeft c)), Typing.typeConstraintRight = (substInType subst (Typing.typeConstraintRight c)), Typing.typeConstraintComment = (Typing.typeConstraintComment c)} + -- | Apply a type substitution to a list of type constraints substituteInConstraints :: Typing.TypeSubst -> [Typing.TypeConstraint] -> [Typing.TypeConstraint] substituteInConstraints subst cs = Lists.map (substituteInConstraint subst) cs + -- | Apply a term substitution to a term substituteInTerm :: Typing.TermSubst -> Core.Term -> Core.Term substituteInTerm subst term0 = diff --git a/src/main/haskell/Hydra/System.hs b/src/main/haskell/Hydra/System.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/System.hs @@ -0,0 +1,70 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A model for a program's interface to the host operating system: running other programs, the environment, the working directory, and process exit status. Names and semantics follow the POSIX System Interfaces (XSH) volume; see https://pubs.opengroup.org/onlinepubs/9799919799. Only the portable, cross-platform subset is modeled. + +module Hydra.System where + +import qualified Hydra.Core as Core +import qualified Hydra.File as File +import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) +import qualified Data.Scientific as Sci +import qualified Data.ByteString as B +import qualified Data.Map as M + +-- | A description of a program to run, supplying the inputs the POSIX posix_spawn / execve family takes: the executable, its argument vector, and optionally a working directory and a replacement environment. Only the portable subset is modeled; POSIX file actions, spawn attributes, and signal masks are omitted. See https://pubs.opengroup.org/onlinepubs/9799919799/functions/posix_spawn.html and https://pubs.opengroup.org/onlinepubs/9799919799/functions/execve.html +data Command = + Command { + -- | The executable to run; a POSIX pathname, resolved against PATH by the host when it contains no slash (as for the execvp/execlp family). POSIX argv[0] (the program name) is supplied by the host from this field + commandProgram :: File.FilePath, + -- | The arguments following the program name, becoming argv[1..] for the child. The program name (argv[0]) is not included here + commandArguments :: [String], + -- | The directory in which to run the child, as if chdir() (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/chdir.html) were called before exec. None inherits the parent's working directory + commandWorkingDirectory :: (Maybe File.FilePath), + -- | The complete environment for the child (POSIX environ). None inherits the parent's environment; given(m) replaces it entirely, as execve's envp argument does. There is no partial-merge form; merge in pure code before calling + commandEnvironment :: (Maybe (M.Map EnvironmentVariable String))} + deriving (Eq, Ord, Read, Show) + +_Command = Core.Name "hydra.system.Command" + +_Command_program = Core.Name "program" + +_Command_arguments = Core.Name "arguments" + +_Command_workingDirectory = Core.Name "workingDirectory" + +_Command_environment = Core.Name "environment" + +-- | The name of an environment variable: its identity within the POSIX environment list environ (XBD section 8, Environment Variables, https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap08.html). POSIX models each entry as a "name=value" string; this type wraps the name, which is the constrained, identifying part: XBD section 8 requires names to consist of characters from the portable character set and to contain no '=' (the name/value separator). A variable's value is an arbitrary string and is left unwrapped +newtype EnvironmentVariable = + EnvironmentVariable { + unEnvironmentVariable :: String} + deriving (Eq, Ord, Read, Show) + +_EnvironmentVariable = Core.Name "hydra.system.EnvironmentVariable" + +-- | The outcome of a child process that ran to completion, as obtained by wait() / waitpid() (XSH, https://pubs.opengroup.org/onlinepubs/9799919799/functions/wait.html) together with its captured output. Only normal termination is modeled directly; abnormal termination (POSIX WIFSIGNALED) is surfaced through exitCode using the host's convention rather than as a separate field +data ProcessResult = + ProcessResult { + -- | The child's exit status (POSIX WEXITSTATUS); 0 denotes success by convention + processResultExitCode :: StatusCode, + -- | The bytes the child wrote to file descriptor 1, standard output (XBD STDOUT_FILENO) + processResultStdout :: B.ByteString, + -- | The bytes the child wrote to file descriptor 2, standard error (XBD STDERR_FILENO) + processResultStderr :: B.ByteString} + deriving (Eq, Ord, Read, Show) + +_ProcessResult = Core.Name "hydra.system.ProcessResult" + +_ProcessResult_exitCode = Core.Name "exitCode" + +_ProcessResult_stdout = Core.Name "stdout" + +_ProcessResult_stderr = Core.Name "stderr" + +-- | A process exit status: the value passed to the POSIX exit() function and reported by wait() / waitpid() for a normally-terminated child (XSH; see https://pubs.opengroup.org/onlinepubs/9799919799/functions/exit.html and https://pubs.opengroup.org/onlinepubs/9799919799/functions/wait.html). By the convention of XCU section 2.8.2, Exit Status for Commands (https://pubs.opengroup.org/onlinepubs/9799919799/utilities/V3_chap02.html#tag_19_08_02), 0 denotes success and non-zero denotes failure. POSIX passes only the low 8 bits of the status through wait(); Hydra widens this to a signed int32 so that host runtimes which expose a fuller code (e.g. Windows process exit codes, or the negative "killed by signal N" convention) can be represented without loss +newtype StatusCode = + StatusCode { + unStatusCode :: Int} + deriving (Eq, Ord, Read, Show) + +_StatusCode = Core.Name "hydra.system.StatusCode" diff --git a/src/main/haskell/Hydra/Tabular.hs b/src/main/haskell/Hydra/Tabular.hs --- a/src/main/haskell/Hydra/Tabular.hs +++ b/src/main/haskell/Hydra/Tabular.hs @@ -1,32 +1,43 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A simple, untyped tabular data model, suitable for CSVs and TSVs module Hydra.Tabular where + import qualified Hydra.Core as Core import qualified Hydra.Relational as Relational import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | A column type, consisting of a name and a value type data ColumnType = ColumnType { columnTypeName :: Relational.ColumnName, columnTypeType :: Core.Type} deriving (Eq, Ord, Read, Show) + _ColumnType = Core.Name "hydra.tabular.ColumnType" + _ColumnType_name = Core.Name "name" + _ColumnType_type = Core.Name "type" + -- | A data row, containing optional-valued cells; one per column newtype DataRow v = DataRow { unDataRow :: [Maybe v]} deriving (Eq, Ord, Read, Show) + _DataRow = Core.Name "hydra.tabular.DataRow" + -- | A header row, containing column names (but no types or data) newtype HeaderRow = HeaderRow { unHeaderRow :: [String]} deriving (Eq, Ord, Read, Show) + _HeaderRow = Core.Name "hydra.tabular.HeaderRow" + -- | A simple table as in a CSV file, having an optional header row and any number of data rows data Table v = Table { @@ -35,15 +46,22 @@ -- | The data rows of the table. Each row must have the same number of cells. tableData :: [DataRow v]} deriving (Eq, Ord, Read, Show) + _Table = Core.Name "hydra.tabular.Table" + _Table_header = Core.Name "header" + _Table_data = Core.Name "data" + -- | A type definition for a table, including column names and types data TableType = TableType { tableTypeName :: Relational.RelationName, tableTypeColumns :: [ColumnType]} deriving (Eq, Ord, Read, Show) + _TableType = Core.Name "hydra.tabular.TableType" + _TableType_name = Core.Name "name" + _TableType_columns = Core.Name "columns" 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 @@ -1,32 +1,40 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A utility which instantiates a nonrecursive type with default values module Hydra.Templates 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.Decode.Core as DecodeCore +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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -36,7 +44,8 @@ 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 Hydra.Haskell.Lib.Literals as Literals +import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals + -- | Decode a list of type-encoding bindings into a map of named types graphToSchema :: t0 -> Graph.Graph -> [Core.Binding] -> Either Errors.DecodingError (M.Map Core.Name Core.Type) graphToSchema cx graph els = @@ -46,6 +55,7 @@ let name = Core.bindingName el in (Eithers.bind (DecodeCore.type_ graph (Core.bindingTerm el)) (\t -> Right (name, t))) in (Eithers.bind (Eithers.mapList toPair els) (\pairs -> Right (Maps.fromList pairs))) + -- | Given a graph schema and a nonrecursive type, instantiate it with default values. If the minimal flag is set, the smallest possible term is produced; otherwise, exactly one subterm is produced for constructors which do not otherwise require one, e.g. in lists and optionals. The name parameter provides the element name for nominal type construction. instantiateTemplate :: t0 -> Bool -> M.Map Core.Name Core.Type -> Core.Name -> Core.Type -> Either Errors.Error Core.Term instantiateTemplate cx minimal schema tname t = 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 @@ -1,31 +1,39 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Transform test cases for code generation, filtering to tests that can be compiled to target languages module Hydra.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.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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.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 @@ -34,9 +42,11 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | Add generation namespace prefix addGenerationPrefix :: Packaging.ModuleName -> Packaging.ModuleName addGenerationPrefix ns_ = Packaging.ModuleName (Strings.cat2 "generation." (Packaging.unModuleName ns_)) + -- | Build a Term representing a convertCase function call buildConvertCaseCall :: Util.CaseConvention -> Util.CaseConvention -> String -> Core.Term buildConvertCaseCall fromConv toConv input_ = @@ -47,26 +57,31 @@ Core.applicationArgument = (encodeCaseConvention fromConv)})), Core.applicationArgument = (encodeCaseConvention toConv)})), Core.applicationArgument = (Core.TermLiteral (Core.LiteralString input_))}) + -- | Build a Term representing a topologicalSort function call buildTopologicalSortCall :: [(Int, [Int])] -> Core.Term buildTopologicalSortCall adjList = Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.topologicalSort")), Core.applicationArgument = (encodeAdjacencyList adjList)}) + -- | Build a Term representing a topologicalSortComponents function call buildTopologicalSortSCCCall :: [(Int, [Int])] -> Core.Term buildTopologicalSortSCCCall adjList = Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.sorting.topologicalSortComponents")), Core.applicationArgument = (encodeAdjacencyList adjList)}) + -- | Collect all test cases from a test group (flattening hierarchy) collectTestCases :: Testing.TestGroup -> [Testing.TestCaseWithMetadata] collectTestCases tg = Lists.concat2 (Testing.testGroupCases tg) (Lists.concat (Lists.map (\sg -> collectTestCases sg) (Testing.testGroupSubgroups tg))) + -- | Encode an adjacency list as a Term encodeAdjacencyList :: [(Int, [Int])] -> Core.Term encodeAdjacencyList pairs = Core.TermList (Lists.map (\p -> Core.TermPair (encodeInt (Pairs.first p), (Core.TermList (Lists.map (\d -> encodeInt d) (Pairs.second p))))) pairs) + -- | Encode CaseConvention as a Term (unit variant) encodeCaseConvention :: Util.CaseConvention -> Core.Term encodeCaseConvention conv = @@ -79,19 +94,24 @@ Util.CaseConventionCamel -> Core.Name "camel" Util.CaseConventionPascal -> Core.Name "pascal", Core.fieldTerm = Core.TermUnit}}) + -- | Encode Either [[Int]] [Int] as a Term encodeEitherListList :: Either [[Int]] [Int] -> Core.Term encodeEitherListList e = Core.TermEither (Eithers.bimap (\cycles -> encodeListList cycles) (\sorted -> encodeIntList sorted) e) + -- | Encode an Int as a Term encodeInt :: Int -> Core.Term encodeInt n = Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 n)) + -- | Encode [Int] as a Term encodeIntList :: [Int] -> Core.Term encodeIntList ints = Core.TermList (Lists.map (\n -> encodeInt n) ints) + -- | Encode [[Int]] as a Term encodeListList :: [[Int]] -> Core.Term encodeListList lists = Core.TermList (Lists.map (\l -> encodeIntList l) lists) + -- | Transform module with generation namespace transformModule :: Packaging.Module -> Packaging.Module transformModule m = @@ -100,9 +120,11 @@ Packaging.moduleMetadata = (Packaging.moduleMetadata m), Packaging.moduleDependencies = (Packaging.moduleDependencies m), Packaging.moduleDefinitions = (Packaging.moduleDefinitions m)} + -- | Pass through test cases unchanged transformTestCase :: t0 -> Maybe t0 transformTestCase tcm = Just tcm + -- | Transform test group hierarchy to only include delegated evaluation tests transformToCompiledTests :: Testing.TestGroup -> Maybe Testing.TestGroup transformToCompiledTests tg = 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 @@ -1,27 +1,35 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Shared utility functions for test code generation codecs module Hydra.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.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.Haskell.Lib.Eithers as Eithers +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers 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.Errors as ShowErrors +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 @@ -30,10 +38,12 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | 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) + -- | Run type inference on the terms in a test case inferTestCase :: t0 -> Testing.TestCaseWithMetadata -> Either t1 Testing.TestCaseWithMetadata inferTestCase g tcm = @@ -47,6 +57,7 @@ Testing.testCaseWithMetadataCase = inferredCase, Testing.testCaseWithMetadataDescription = desc, Testing.testCaseWithMetadataTags = tags_}) (Right tcase)) + -- | Run type inference on all terms in a TestGroup to ensure lambdas have domain types inferTestGroupTerms :: t0 -> Testing.TestGroup -> Either t1 Testing.TestGroup inferTestGroupTerms g tg = diff --git a/src/main/haskell/Hydra/Testing.hs b/src/main/haskell/Hydra/Testing.hs --- a/src/main/haskell/Hydra/Testing.hs +++ b/src/main/haskell/Hydra/Testing.hs @@ -1,22 +1,48 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model for unit testing module Hydra.Testing where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + +-- | An effectful test case: the actual value is a thunk producing an effect, which the test runner interprets (performing host interactions, e.g. file I/O within a per-case empty temporary directory) to obtain a result string; the expected value is a thunk producing a string. +data EffectfulTestCase = + EffectfulTestCase { + -- | A thunk producing the effect to be interpreted by the test runner. The thunk defers construction of the effect until the runner forces it. + effectfulTestCaseActual :: (() -> IO String), + -- | A thunk producing the expected result string. + effectfulTestCaseExpected :: (() -> String)} + +_EffectfulTestCase = Core.Name "hydra.testing.EffectfulTestCase" + +_EffectfulTestCase_actual = Core.Name "actual" + +_EffectfulTestCase_expected = Core.Name "expected" + -- | A tag for test cases newtype Tag = Tag { unTag :: String} deriving (Eq, Ord, Read, Show) + _Tag = Core.Name "hydra.testing.Tag" + -- | A test case with an actual and expected string for comparison data TestCase = + -- | An effectful test case (interpret an effect, then string comparison) + TestCaseEffectful EffectfulTestCase | -- | A universal test case (string comparison) TestCaseUniversal UniversalTestCase + _TestCase = Core.Name "hydra.testing.TestCase" + +_TestCase_effectful = Core.Name "effectful" + _TestCase_universal = Core.Name "universal" + -- | A test case together with metadata data TestCaseWithMetadata = TestCaseWithMetadata { @@ -28,11 +54,17 @@ testCaseWithMetadataDescription :: (Maybe String), -- | Zero or more tags for the test case testCaseWithMetadataTags :: [Tag]} + _TestCaseWithMetadata = Core.Name "hydra.testing.TestCaseWithMetadata" + _TestCaseWithMetadata_name = Core.Name "name" + _TestCaseWithMetadata_case = Core.Name "case" + _TestCaseWithMetadata_description = Core.Name "description" + _TestCaseWithMetadata_tags = Core.Name "tags" + -- | A collection of test cases with a name and optional description data TestGroup = TestGroup { @@ -44,11 +76,17 @@ testGroupSubgroups :: [TestGroup], -- | Zero or more test cases testGroupCases :: [TestCaseWithMetadata]} + _TestGroup = Core.Name "hydra.testing.TestGroup" + _TestGroup_name = Core.Name "name" + _TestGroup_description = Core.Name "description" + _TestGroup_subgroups = Core.Name "subgroups" + _TestGroup_cases = Core.Name "cases" + -- | A universal test case: the actual and expected values are thunks producing strings. data UniversalTestCase = UniversalTestCase { @@ -56,6 +94,9 @@ universalTestCaseActual :: (() -> String), -- | A thunk producing the expected result string. universalTestCaseExpected :: (() -> String)} + _UniversalTestCase = Core.Name "hydra.testing.UniversalTestCase" + _UniversalTestCase_actual = Core.Name "actual" + _UniversalTestCase_expected = Core.Name "expected" diff --git a/src/main/haskell/Hydra/Time.hs b/src/main/haskell/Hydra/Time.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Time.hs @@ -0,0 +1,25 @@ +-- Note: this is an automatically generated file. Do not edit. + +-- | A model for points in time + +module Hydra.Time 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.Int as I + +-- | The POSIX struct timespec, with the same semantics: an instant in time as a number of seconds and nanoseconds since the Unix Epoch (1970-01-01T00:00:00Z). The actual resolution is implementation- and filesystem-defined. See (https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/time.h.html) and XBD section 4.19, "Seconds Since the Epoch" (https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/V1_chap04.html#tag_04_19). +data Timespec = + Timespec { + -- | Whole seconds since the Unix Epoch; signed, so instants in the far past or distant future are representable + timespecSeconds :: I.Int64, + -- | Nanoseconds within the second, in the range [0, 999999999]; unsigned, as the value is never negative + timespecNanoseconds :: I.Int64} + deriving (Eq, Ord, Read, Show) + +_Timespec = Core.Name "hydra.time.Timespec" + +_Timespec_seconds = Core.Name "seconds" + +_Timespec_nanoseconds = Core.Name "nanoseconds" diff --git a/src/main/haskell/Hydra/Topology.hs b/src/main/haskell/Hydra/Topology.hs --- a/src/main/haskell/Hydra/Topology.hs +++ b/src/main/haskell/Hydra/Topology.hs @@ -1,15 +1,20 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A model for simple graphs as adjacency lists module Hydra.Topology 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 import qualified Data.Set as S + -- | A directed graph represented as an adjacency list mapping vertices to their outgoing neighbors type Graph = (M.Map Vertex [Vertex]) + _Graph = Core.Name "hydra.topology.Graph" + -- | A pair of inverse permutations on lists, used to relate two orderings of the same elements data OrderingIsomorphism a = OrderingIsomorphism { @@ -17,9 +22,13 @@ orderingIsomorphismEncode :: ([a] -> [a]), -- | Mapping from target ordering to source ordering orderingIsomorphismDecode :: ([a] -> [a])} + _OrderingIsomorphism = Core.Name "hydra.topology.OrderingIsomorphism" + _OrderingIsomorphism_encode = Core.Name "encode" + _OrderingIsomorphism_decode = Core.Name "decode" + -- | State carried by Tarjan's strongly connected components algorithm during a depth-first traversal data TarjanState = TarjanState { @@ -36,13 +45,22 @@ -- | Accumulated strongly connected components, each a list of vertices tarjanStateSccs :: [[Vertex]]} deriving (Eq, Ord, Read, Show) + _TarjanState = Core.Name "hydra.topology.TarjanState" + _TarjanState_counter = Core.Name "counter" + _TarjanState_indices = Core.Name "indices" + _TarjanState_lowLinks = Core.Name "lowLinks" + _TarjanState_stack = Core.Name "stack" + _TarjanState_onStack = Core.Name "onStack" + _TarjanState_sccs = Core.Name "sccs" + -- | A graph vertex, represented as a 32-bit integer identifier type Vertex = Int + _Vertex = Core.Name "hydra.topology.Vertex" 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 @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Typed (phantom) wrappers for use with Hydra DSLs module Hydra.Typed where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | An association of a named term (element) with a phantom type data TypedBinding a = TypedBinding { @@ -13,15 +16,21 @@ -- | The term with its phantom type typedBindingTerm :: (TypedTerm a)} deriving (Eq, Ord, Read, Show) + _TypedBinding = Core.Name "hydra.typed.TypedBinding" + _TypedBinding_name = Core.Name "name" + _TypedBinding_term = Core.Name "term" + -- | An association of a term with a phantom type newtype TypedTerm a = TypedTerm { unTypedTerm :: Core.Term} deriving (Eq, Ord, Read, Show) + _TypedTerm = Core.Name "hydra.typed.TypedTerm" + -- | An association of a term definition with a phantom type data TypedTermDefinition a = TypedTermDefinition { @@ -30,6 +39,9 @@ -- | The term with its phantom type typedTermDefinitionTerm :: (TypedTerm a)} deriving (Eq, Ord, Read, Show) + _TypedTermDefinition = Core.Name "hydra.typed.TypedTermDefinition" + _TypedTermDefinition_name = Core.Name "name" + _TypedTermDefinition_term = Core.Name "term" diff --git a/src/main/haskell/Hydra/Typing.hs b/src/main/haskell/Hydra/Typing.hs --- a/src/main/haskell/Hydra/Typing.hs +++ b/src/main/haskell/Hydra/Typing.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Types supporting type inference and type reconstruction. module Hydra.Typing where + import qualified Hydra.Core as Core import qualified Hydra.Paths as Paths import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | A structured representation of a function term's components, replacing ad-hoc tuples. This captures all the information extracted from peeling lambdas, type lambdas, lets, and type applications from a term. data FunctionStructure env = FunctionStructure { @@ -25,14 +28,23 @@ -- | Updated environment after processing all bindings functionStructureEnvironment :: env} deriving (Eq, Ord, Read, Show) + _FunctionStructure = Core.Name "hydra.typing.FunctionStructure" + _FunctionStructure_typeParams = Core.Name "typeParams" + _FunctionStructure_params = Core.Name "params" + _FunctionStructure_bindings = Core.Name "bindings" + _FunctionStructure_body = Core.Name "body" + _FunctionStructure_domains = Core.Name "domains" + _FunctionStructure_codomain = Core.Name "codomain" + _FunctionStructure_environment = Core.Name "environment" + -- | State threaded through type inference: the fresh type variable counter and the current subterm-path trace. data InferenceContext = InferenceContext { @@ -41,9 +53,13 @@ -- | The current subterm-path trace, accumulated backwards (head = most-recently-pushed step, corresponding to the deepest point in the descent). At the moment an inference error is constructed, the list is reversed and wrapped into a SubtermPath (root-to-leaf order) and stamped onto the error. inferenceContextTrace :: [Paths.SubtermStep]} deriving (Eq, Ord, Read, Show) + _InferenceContext = Core.Name "hydra.typing.InferenceContext" + _InferenceContext_freshTypeVariableCount = Core.Name "freshTypeVariableCount" + _InferenceContext_trace = Core.Name "trace" + -- | The result of applying inference rules to a term. data InferenceResult = InferenceResult { @@ -58,12 +74,19 @@ -- | The updated InferenceContext after inference (carries fresh-variable counter and trace) inferenceResultContext :: InferenceContext} deriving (Eq, Ord, Read, Show) + _InferenceResult = Core.Name "hydra.typing.InferenceResult" + _InferenceResult_term = Core.Name "term" + _InferenceResult_type = Core.Name "type" + _InferenceResult_subst = Core.Name "subst" + _InferenceResult_classConstraints = Core.Name "classConstraints" + _InferenceResult_context = Core.Name "context" + -- | A named, typed parameter of a term, with optional human-readable description and a flag indicating whether the parameter requires lazy evaluation by hosts which support it. data Parameter = Parameter { @@ -76,11 +99,17 @@ -- | Whether the parameter must be passed lazily (thunked) at call sites in hosts that distinguish strict from lazy evaluation parameterIsLazy :: Bool} deriving (Eq, Ord, Read, Show) + _Parameter = Core.Name "hydra.typing.Parameter" + _Parameter_name = Core.Name "name" + _Parameter_description = Core.Name "description" + _Parameter_type = Core.Name "type" + _Parameter_isLazy = Core.Name "isLazy" + -- | The result of a term, consisting of a type and an optional human-readable description. data Result = Result { @@ -89,9 +118,13 @@ -- | The type of the result resultType :: Core.Type} deriving (Eq, Ord, Read, Show) + _Result = Core.Name "hydra.typing.Result" + _Result_description = Core.Name "description" + _Result_type = Core.Name "type" + -- | A structured signature for a term: an ordered list of type parameters (with optional class constraints), an ordered list of value parameters, and a result. TermSignature is a richer view of TypeScheme: every TermSignature can be converted to a TypeScheme by erasing parameter names, descriptions, and laziness flags. data TermSignature = TermSignature { @@ -102,24 +135,34 @@ -- | The result of the term termSignatureResult :: Result} deriving (Eq, Ord, Read, Show) + _TermSignature = Core.Name "hydra.typing.TermSignature" + _TermSignature_typeParameters = Core.Name "typeParameters" + _TermSignature_parameters = Core.Name "parameters" + _TermSignature_result = Core.Name "result" + -- | A substitution of term variables for terms newtype TermSubst = TermSubst { unTermSubst :: (M.Map Core.Name Core.Term)} deriving (Eq, Ord, Read, Show) + _TermSubst = Core.Name "hydra.typing.TermSubst" + -- | A type class identifier together with a human-readable description. Type classes are referenced as bare names (e.g. the local name "equality") in TypeVariableConstraints.classes; the canonical definitions live as term bindings under hydra.classes. data TypeClass = TypeClass { -- | A human-readable description of the type class typeClassDescription :: String} deriving (Eq, Ord, Read, Show) + _TypeClass = Core.Name "hydra.typing.TypeClass" + _TypeClass_description = Core.Name "description" + -- | An assertion that two types can be unified into a single type data TypeConstraint = TypeConstraint { @@ -130,10 +173,15 @@ -- | A description of the type constraint which may be used for tracing or debugging typeConstraintComment :: String} deriving (Eq, Ord, Read, Show) + _TypeConstraint = Core.Name "hydra.typing.TypeConstraint" + _TypeConstraint_left = Core.Name "left" + _TypeConstraint_right = Core.Name "right" + _TypeConstraint_comment = Core.Name "comment" + -- | A type parameter of a term, with an optional list of type class constraints data TypeParameter = TypeParameter { @@ -142,12 +190,17 @@ -- | Any type class constraints on the type parameter typeParameterConstraints :: [Core.TypeClassConstraint]} deriving (Eq, Ord, Read, Show) + _TypeParameter = Core.Name "hydra.typing.TypeParameter" + _TypeParameter_name = Core.Name "name" + _TypeParameter_constraints = Core.Name "constraints" + -- | A substitution of type variables for types newtype TypeSubst = TypeSubst { unTypeSubst :: (M.Map Core.Name Core.Type)} deriving (Eq, Ord, Read, Show) + _TypeSubst = Core.Name "hydra.typing.TypeSubst" 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 @@ -1,24 +1,30 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Utilities for type unification. module Hydra.Unification 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.Haskell.Lib.Eithers as Eithers -import qualified Hydra.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Strings as Strings +import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers +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.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.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths @@ -28,8 +34,10 @@ 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 +import qualified Hydra.Time as Time import qualified Hydra.Topology as Topology import qualified Hydra.Typed as Typed import qualified Hydra.Typing as Typing @@ -39,6 +47,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | Join two types, producing a list of type constraints.The comment is used to provide context for the constraints. joinTypes :: t0 -> Core.Type -> Core.Type -> String -> Either Errors.UnificationError [Typing.TypeConstraint] joinTypes cx left right comment = @@ -59,7 +68,7 @@ joinList = \lefts -> \rights -> Logic.ifElse (Equality.equal (Lists.length lefts) (Lists.length rights)) (Right (Lists.zipWith joinOne lefts rights)) cannotUnify joinRowTypes = - \left2 -> \right2 -> Logic.ifElse (Logic.and (Equality.equal (Lists.length (Lists.map Core.fieldTypeName left2)) (Lists.length (Lists.map Core.fieldTypeName right2))) (Lists.foldl Logic.and True (Lists.zipWith (\left3 -> \right3 -> Equality.equal (Core.unName left3) (Core.unName right3)) (Lists.map Core.fieldTypeName left2) (Lists.map Core.fieldTypeName right2)))) (joinList (Lists.map Core.fieldTypeType left2) (Lists.map Core.fieldTypeType right2)) cannotUnify + \left2 -> \right2 -> Logic.ifElse (Logic.and (Equality.equal (Lists.length (Lists.map Core.fieldTypeName left2)) (Lists.length (Lists.map Core.fieldTypeName right2))) (Lists.foldl (\acc -> \x -> Logic.and acc x) True (Lists.zipWith (\left3 -> \right3 -> Equality.equal (Core.unName left3) (Core.unName right3)) (Lists.map Core.fieldTypeName left2) (Lists.map Core.fieldTypeName right2)))) (joinList (Lists.map Core.fieldTypeType left2) (Lists.map Core.fieldTypeType right2)) cannotUnify in case sleft of Core.TypeApplication v0 -> case sright of Core.TypeApplication v1 -> Right [ @@ -71,6 +80,10 @@ joinOne (Core.eitherTypeLeft v0) (Core.eitherTypeLeft v1), (joinOne (Core.eitherTypeRight v0) (Core.eitherTypeRight v1))] _ -> cannotUnify + Core.TypeEffect v0 -> case sright of + Core.TypeEffect v1 -> Right [ + joinOne v0 v1] + _ -> cannotUnify Core.TypeFunction v0 -> case sright of Core.TypeFunction v1 -> Right [ joinOne (Core.functionTypeDomain v0) (Core.functionTypeDomain v1), @@ -116,6 +129,7 @@ joinOne v0 v1] _ -> cannotUnify _ -> cannotUnify + -- | Robinson's algorithm, following https://www.cs.cornell.edu/courses/cs6110/2017sp/lectures/lec23.pdf -- | Specifically this is an implementation of the following rules: -- | * Unify({(x, t)} ∪ E) = {t/x} Unify(E{t/x}) if x ∉ FV(t) @@ -157,6 +171,7 @@ _ -> tryBinding v0 sright _ -> dflt in (Optionals.cases (Lists.uncons constraints) (Right Substitution.idTypeSubst) (\uc -> withConstraint (Pairs.first uc) (Pairs.second uc))) + -- | Unify two lists of types pairwise, producing a single substitution that satisfies every pair. The lists must have the same length; the comment is attached to each generated constraint for diagnostics. unifyTypeLists :: t0 -> M.Map Core.Name t1 -> [Core.Type] -> [Core.Type] -> String -> Either Errors.UnificationError Typing.TypeSubst unifyTypeLists cx schemaTypes l r comment = @@ -167,6 +182,7 @@ Typing.typeConstraintRight = r2, Typing.typeConstraintComment = comment} in (unifyTypeConstraints cx schemaTypes (Lists.zipWith toConstraint l r)) + -- | Unify two types, producing a substitution that makes them equal (or an error). The comment is attached to the generated constraint for diagnostics. unifyTypes :: t0 -> M.Map Core.Name t1 -> Core.Type -> Core.Type -> String -> Either Errors.UnificationError Typing.TypeSubst unifyTypes cx schemaTypes l r comment = @@ -175,6 +191,7 @@ Typing.typeConstraintLeft = l, Typing.typeConstraintRight = r, Typing.typeConstraintComment = comment}] + -- | Determine whether a type variable appears within a type expression.No distinction is made between free and bound type variables. variableOccursInType :: Core.Name -> Core.Type -> Bool variableOccursInType var typ0 = diff --git a/src/main/haskell/Hydra/Util.hs b/src/main/haskell/Hydra/Util.hs --- a/src/main/haskell/Hydra/Util.hs +++ b/src/main/haskell/Hydra/Util.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | General-purpose utility types used across Hydra. module Hydra.Util where + import qualified Hydra.Core as Core import qualified Hydra.Packaging as Packaging import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Map as M + -- | A naming convention for symbols, such as camelCase or snake_case data CaseConvention = CaseConventionCamel | @@ -14,27 +17,32 @@ CaseConventionLowerSnake | CaseConventionUpperSnake deriving (Eq, Ord, Read, Show) + _CaseConvention = Core.Name "hydra.util.CaseConvention" + _CaseConvention_camel = Core.Name "camel" + _CaseConvention_pascal = Core.Name "pascal" + _CaseConvention_lowerSnake = Core.Name "lowerSnake" + _CaseConvention_upperSnake = Core.Name "upperSnake" + -- | An equality judgement: less than, equal to, or greater than data Comparison = ComparisonLessThan | ComparisonEqualTo | ComparisonGreaterThan deriving (Eq, Ord, Read, Show) + _Comparison = Core.Name "hydra.util.Comparison" + _Comparison_lessThan = Core.Name "lessThan" + _Comparison_equalTo = Core.Name "equalTo" + _Comparison_greaterThan = Core.Name "greaterThan" --- | A file extension (without the dot), e.g. "json" or "py" -newtype FileExtension = - FileExtension { - unFileExtension :: String} - deriving (Eq, Ord, Read, Show) -_FileExtension = Core.Name "hydra.util.FileExtension" + -- | A mapping from module names to values of type n, with a focus on one module name data ModuleNames n = ModuleNames { @@ -43,9 +51,13 @@ -- | A mapping of module names to values moduleNamesMapping :: (M.Map Packaging.ModuleName n)} deriving (Eq, Ord, Read, Show) + _ModuleNames = Core.Name "hydra.util.ModuleNames" + _ModuleNames_focus = Core.Name "focus" + _ModuleNames_mapping = Core.Name "mapping" + -- | Numeric precision: arbitrary precision, or precision to a specified number of bits data Precision = -- | Arbitrary precision @@ -53,9 +65,13 @@ -- | Precision to a specified number of bits PrecisionBits Int deriving (Eq, Ord, Read, Show) + _Precision = Core.Name "hydra.util.Precision" + _Precision_arbitrary = Core.Name "arbitrary" + _Precision_bits = Core.Name "bits" + -- | A qualified name consisting of an optional module name together with a mandatory local name data QualifiedName = QualifiedName { @@ -64,6 +80,9 @@ -- | The local name qualifiedNameLocal :: String} deriving (Eq, Ord, Read, Show) + _QualifiedName = Core.Name "hydra.util.QualifiedName" + _QualifiedName_moduleName = Core.Name "moduleName" + _QualifiedName_local = Core.Name "local" 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 @@ -1,24 +1,30 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Validation functions for core terms and types module Hydra.Validate.Core where + import qualified Hydra.Annotations as Annotations 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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets +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.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.Packaging as Packaging import qualified Hydra.Parsing as Parsing import qualified Hydra.Paths as Paths @@ -26,8 +32,10 @@ import qualified Hydra.Reflect as Reflect 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 @@ -38,6 +46,7 @@ import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | Append a rule-tagged InvalidTermError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFinding :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFinding p acc finding = @@ -51,6 +60,7 @@ 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.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) + -- | Append a rule-tagged InvalidTypeError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFindingType :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingType p acc finding = @@ -64,6 +74,7 @@ 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.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) + -- | Check for duplicate binding names in a list of bindings checkDuplicateBindings :: Paths.SubtermPath -> [Core.Binding] -> Maybe ErrorCore.InvalidTermError checkDuplicateBindings path bindings = @@ -73,6 +84,7 @@ in (Optionals.map (\name -> ErrorCore.InvalidTermErrorDuplicateBinding (ErrorCore.DuplicateBindingError { ErrorCore.duplicateBindingErrorLocation = path, ErrorCore.duplicateBindingErrorName = name})) dup) + -- | Check for duplicate field names in a list of field types checkDuplicateFieldTypes :: [Core.FieldType] -> (Core.Name -> Maybe t0) -> Maybe t0 checkDuplicateFieldTypes fields mkError = @@ -80,6 +92,7 @@ let names = Lists.map Core.fieldTypeName fields dup = findDuplicateFieldType names in (Optionals.cases dup Nothing (\name -> mkError name)) + -- | Check for duplicate field names in a list of fields checkDuplicateFields :: Paths.SubtermPath -> [Core.Name] -> Maybe ErrorCore.InvalidTermError checkDuplicateFields path names = @@ -88,6 +101,7 @@ in (Optionals.map (\name -> ErrorCore.InvalidTermErrorDuplicateField (ErrorCore.DuplicateFieldError { ErrorCore.duplicateFieldErrorLocation = path, ErrorCore.duplicateFieldErrorName = name})) dup) + -- | Check that a literal value's type matches an expected literal type checkLiteral :: Core.LiteralType -> Core.Literal -> Maybe ErrorCore.InvalidLiteralError checkLiteral expected value = @@ -96,6 +110,7 @@ in (Logic.ifElse (Equality.equal expected actual) Nothing (Just (ErrorCore.InvalidLiteralErrorTypeMismatch (ErrorCore.LiteralTypeMismatchError { ErrorCore.literalTypeMismatchErrorExpectedType = expected, ErrorCore.literalTypeMismatchErrorActualType = actual})))) + -- | Check if any name in a list shadows a variable already in scope checkShadowing :: Paths.SubtermPath -> Graph.Graph -> [Core.Name] -> Maybe ErrorCore.InvalidTermError checkShadowing path cx names = @@ -105,6 +120,7 @@ ErrorCore.termVariableShadowingErrorLocation = path, ErrorCore.termVariableShadowingErrorName = name}))) Nothing) (\_ -> acc)) Nothing names in result + -- | Check a single term node for validation errors. Rules disabled by the profile are not evaluated. checkTerm :: Validation.ValidationProfile -> Bool -> Paths.SubtermPath -> Graph.Graph -> Core.Term -> Maybe (Core.Name, ErrorCore.InvalidTermError) checkTerm p typed path cx term = @@ -229,6 +245,7 @@ in (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) _ -> Nothing + -- | Check a type for type variables not bound in the current scope checkUndefinedTypeVariablesInType :: t0 -> Graph.Graph -> Core.Type -> (Core.Name -> Maybe t1) -> Maybe t1 checkUndefinedTypeVariablesInType path cx typ mkError = @@ -236,6 +253,7 @@ let freeVars = Variables.freeVariablesInType typ undefined = Sets.difference freeVars (Graph.graphTypeVariables cx) in (Optionals.cases (Lists.maybeHead (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 = @@ -243,6 +261,7 @@ let freeVars = Variables.freeVariablesInTypeScheme ts undefined = Sets.difference freeVars (Graph.graphTypeVariables cx) in (Optionals.cases (Lists.maybeHead (Sets.toList undefined)) Nothing (\firstUndefined -> mkError firstUndefined)) + -- | Return an error if the given type is TypeVoid checkVoid :: Core.Type -> Maybe ErrorCore.InvalidTypeError checkVoid typ = @@ -250,10 +269,12 @@ Core.TypeVoid -> Just (ErrorCore.InvalidTypeErrorVoidInNonBottomPosition (ErrorCore.VoidInNonBottomPositionError { ErrorCore.voidInNonBottomPositionErrorLocation = (Paths.SubtermPath [])})) _ -> Nothing + -- | True iff the given rule name appears in the profile's errorRules or warningRules. enabled :: Validation.ValidationProfile -> Core.Name -> Bool enabled p ruleName = Logic.or (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Sets.member ruleName (Validation.validationProfileWarningRules p)) + -- | Find the first duplicate name in a list findDuplicate :: Ord t0 => ([t0] -> Maybe t0) findDuplicate names = @@ -264,6 +285,7 @@ dup = Pairs.second acc in (Optionals.cases dup (Logic.ifElse (Sets.member name seen) (seen, (Just name)) (Sets.insert name seen, Nothing)) (\_ -> acc))) (Sets.empty, Nothing) names in (Pairs.second result) + -- | Find the first duplicate name in a list (for field type validation) findDuplicateFieldType :: Ord t0 => ([t0] -> Maybe t0) findDuplicateFieldType names = @@ -274,21 +296,27 @@ dup = Pairs.second acc in (Optionals.cases dup (Logic.ifElse (Sets.member name seen) (seen, (Just name)) (Sets.insert name seen, Nothing)) (\_ -> acc))) (Sets.empty, Nothing) names in (Pairs.second result) + -- | Return the first error from a list of optional errors, or nothing if all are valid firstError :: [Maybe t0] -> Maybe t0 firstError checks = Lists.foldl (\acc -> \check -> Optionals.cases acc check (\_ -> acc)) Nothing checks + -- | Return the first rule-tagged finding from a list, or nothing if all are valid firstFinding :: [Maybe t0] -> Maybe t0 firstFinding checks = Lists.foldl (\acc -> \check -> Optionals.cases acc check (\_ -> acc)) Nothing checks + -- | Return the first rule-tagged type finding from a list, or nothing if all are valid firstFindingType :: [Maybe t0] -> Maybe t0 firstFindingType checks = Lists.foldl (\acc -> \check -> Optionals.cases acc check (\_ -> acc)) Nothing checks + -- | Return the first type error from a list of optional errors, or nothing if all are valid firstTypeError :: [Maybe t0] -> Maybe t0 firstTypeError checks = Lists.foldl (\acc -> \check -> Optionals.cases acc check (\_ -> acc)) Nothing checks + -- | Check whether a name is valid at an introduction site. Currently rejects empty strings. isValidName :: Core.Name -> Bool isValidName name = Logic.not (Equality.equal (Core.unName name) "") + -- | The default validation profile for term and type validation, with every check classified as an error except InvalidTypeError.singleVariantUnion (warning); maxErrors=1, maxWarnings=20. kernelDefaultCoreProfile :: Validation.ValidationProfile kernelDefaultCoreProfile = @@ -333,6 +361,7 @@ Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion"]), Validation.validationProfileMaxErrors = 1, Validation.validationProfileMaxWarnings = 20} + -- | 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 = @@ -341,6 +370,7 @@ in (Logic.ifElse (Equality.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 = @@ -354,6 +384,7 @@ Core.TypeApplication v0 -> let acc2 = type_ p acc1 boundVars (Core.applicationTypeFunction v0) in (type_ p acc2 boundVars (Core.applicationTypeArgument v0)) + Core.TypeEffect v0 -> type_ p acc1 boundVars v0 Core.TypeEither v0 -> let acc2 = type_ p acc1 boundVars (Core.eitherTypeLeft v0) in (type_ p acc2 boundVars (Core.eitherTypeRight v0)) @@ -373,6 +404,7 @@ Core.TypeUnion v0 -> Lists.foldl (\a -> \f -> type_ p a boundVars (Core.fieldTypeType f)) acc1 v0 Core.TypeWrap v0 -> type_ p acc1 boundVars v0 _ -> acc1))) + -- | Check a single type node for validation errors. Rules disabled by the profile are not evaluated. validateTypeNode :: Validation.ValidationProfile -> S.Set Core.Name -> Core.Type -> Maybe (Core.Name, ErrorCore.InvalidTypeError) validateTypeNode p boundVars typ = @@ -390,6 +422,7 @@ Core.TypeEither v0 -> firstFindingType [ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition", f)) (checkVoid (Core.eitherTypeLeft v0))) Nothing, (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition", f)) (checkVoid (Core.eitherTypeRight v0))) Nothing)] + Core.TypeEffect v0 -> Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition", f)) (checkVoid v0)) Nothing Core.TypeForall v0 -> let paramName = Core.forallTypeParameter v0 in (firstFindingType [ 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 @@ -1,36 +1,44 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Validation functions for modules and packages module Hydra.Validate.Packaging 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 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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Regex as Regex -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.Regex as Regex +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.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 @@ -39,6 +47,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | 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 appendFindingModule p acc finding = @@ -52,6 +61,7 @@ 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.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) + -- | Append a rule-tagged InvalidPackageError finding to a ValidationResult, classifying as error or warning per the profile and respecting maxErrors/maxWarnings bounds. appendFindingPackage :: Validation.ValidationProfile -> Validation.ValidationResult t0 -> Maybe (Core.Name, t0) -> Validation.ValidationResult t0 appendFindingPackage p acc finding = @@ -65,6 +75,7 @@ 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.validationResultErrors = errs, Validation.validationResultWarnings = (Lists.concat2 wrns (Lists.singleton payload))}) acc) acc))) + -- | Check for module namespaces that conflict when mapped to target language paths checkConflictingModuleNames :: Packaging.Package -> Maybe ErrorPackaging.InvalidPackageError checkConflictingModuleNames pkg = @@ -83,6 +94,7 @@ ErrorPackaging.conflictingModuleNameErrorFirst = first, ErrorPackaging.conflictingModuleNameErrorSecond = ns}))))))) (\_ -> acc))) (Maps.empty, Nothing) (Packaging.packageModules pkg) in (Pairs.second result) + -- | Check for union variant names that, when mapped to constructor names, conflict with other type definitions checkConflictingVariantNames :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkConflictingVariantNames mod = @@ -107,6 +119,7 @@ ErrorPackaging.conflictingVariantNameErrorConflictingName = (Core.Name constructorName)}))) Nothing)) (\_ -> innerAcc)) Nothing v1 _ -> Nothing _ -> Nothing) (\_ -> acc)) Nothing defs) + -- | Check that every top-level definition is wrapped in a description annotation checkDefinitionDocumentation :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkDefinitionDocumentation mod = @@ -131,6 +144,7 @@ in (Logic.ifElse documented Nothing (Just (ErrorPackaging.InvalidModuleErrorMissingDocumentation (ErrorPackaging.MissingDocumentationError { ErrorPackaging.missingDocumentationErrorModuleName = ns, ErrorPackaging.missingDocumentationErrorName = name}))))) (\_ -> acc)) Nothing (Packaging.moduleDefinitions mod)) + -- | Check that all definition names in a module have the module's name as a prefix checkDefinitionModuleNames :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkDefinitionModuleNames mod = @@ -145,6 +159,7 @@ in (Logic.ifElse (Equality.equal (Strings.fromList namePrefix) prefix) Nothing (Just (ErrorPackaging.InvalidModuleErrorDefinitionNotInModuleName (ErrorPackaging.DefinitionNotInModuleNameError { ErrorPackaging.definitionNotInModuleNameErrorModuleName = ns, ErrorPackaging.definitionNotInModuleNameErrorName = name}))))) (\_ -> acc)) Nothing (Packaging.moduleDefinitions mod)) + -- | Check that term definitions have camelCase local names and type definitions have PascalCase local names checkDefinitionNameConvention :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkDefinitionNameConvention mod = @@ -169,6 +184,7 @@ ErrorPackaging.invalidDefinitionNameErrorModuleName = ns, ErrorPackaging.invalidDefinitionNameErrorName = name, ErrorPackaging.invalidDefinitionNameErrorExpectedConvention = expected}))))) (\_ -> acc)) Nothing (Packaging.moduleDefinitions mod)) + -- | Check that a module's definitions list is sorted in ascending lexicographic order by local name checkDefinitionOrdering :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkDefinitionOrdering mod = @@ -190,6 +206,7 @@ ErrorPackaging.definitionsOutOfOrderErrorPrecedingName = prevName, ErrorPackaging.definitionsOutOfOrderErrorFollowingName = currName})))))))) (\_ -> acc))) (Nothing, Nothing) (Packaging.moduleDefinitions mod) in (Pairs.second result) + -- | Check for duplicate definition names in a module checkDuplicateDefinitionNames :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkDuplicateDefinitionNames mod = @@ -207,6 +224,7 @@ ErrorPackaging.duplicateDefinitionNameErrorModuleName = ns, ErrorPackaging.duplicateDefinitionNameErrorName = name})))) (Sets.insert name seen, Nothing))) (\_ -> acc))) (Sets.empty, Nothing) (Packaging.moduleDefinitions mod) in (Pairs.second result) + -- | Check for duplicate module namespaces in a package checkDuplicateModuleNames :: Packaging.Package -> Maybe ErrorPackaging.InvalidPackageError checkDuplicateModuleNames pkg = @@ -222,6 +240,7 @@ (Just (ErrorPackaging.InvalidPackageErrorDuplicateModuleName (ErrorPackaging.DuplicateModuleNameError { ErrorPackaging.duplicateModuleNameErrorModuleName = ns})))) (Sets.insert ns seen, Nothing))) (\_ -> acc))) (Sets.empty, Nothing) (Packaging.packageModules pkg) in (Pairs.second result) + -- | Check that the module's namespace matches the dotted-lowercase naming convention checkModuleNameConvention :: Packaging.Module -> Maybe ErrorPackaging.InvalidModuleError checkModuleNameConvention mod = @@ -229,6 +248,7 @@ let ns = Packaging.moduleName mod in (Logic.ifElse (Regex.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 checkPackageNameConvention :: Packaging.Package -> Maybe ErrorPackaging.InvalidPackageError checkPackageNameConvention pkg = @@ -236,6 +256,7 @@ let pname = Packaging.packageName pkg in (Logic.ifElse (Regex.matches Constants.regexPackageName (Packaging.unPackageName pname)) Nothing (Just (ErrorPackaging.InvalidPackageErrorInvalidPackageName (ErrorPackaging.InvalidPackageNameError { ErrorPackaging.invalidPackageNameErrorPackageName = pname})))) + -- | Extract the name from a definition definitionName :: Packaging.Definition -> Core.Name definitionName def = @@ -243,10 +264,12 @@ Packaging.DefinitionTerm v0 -> Packaging.termDefinitionName v0 Packaging.DefinitionType v0 -> Packaging.typeDefinitionName v0 Packaging.DefinitionPrimitive v0 -> Packaging.primitiveDefinitionName v0 + -- | True iff the given rule name appears in the profile's errorRules or warningRules. enabledPackaging :: Validation.ValidationProfile -> Core.Name -> Bool enabledPackaging p ruleName = Logic.or (Sets.member ruleName (Validation.validationProfileErrorRules p)) (Sets.member ruleName (Validation.validationProfileWarningRules p)) + -- | The default validation profile for module/package validation. Every kernel-shipped check classified as an error; no warnings; maxErrors=1, maxWarnings=20. kernelDefaultPackagingProfile :: Validation.ValidationProfile kernelDefaultPackagingProfile = @@ -265,18 +288,21 @@ Validation.validationProfileWarningRules = Sets.empty, Validation.validationProfileMaxErrors = 1, Validation.validationProfileMaxWarnings = 20} + -- | 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 { 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 { Validation.validationResultErrors = [], Validation.validationResultWarnings = []}) pkg)) + -- | 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 = @@ -288,6 +314,7 @@ (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.definitionsOutOfOrder")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.definitionsOutOfOrder", f)) (checkDefinitionOrdering mod)) Nothing), (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.duplicateDefinitionName")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.duplicateDefinitionName", f)) (checkDuplicateDefinitionNames mod)) Nothing), (Logic.ifElse (enabledPackaging p (Core.Name "hydra.error.packaging.InvalidModuleError.invalidModuleNameConvention")) (Optionals.map (\f -> (Core.Name "hydra.error.packaging.InvalidModuleError.invalidModuleNameConvention", f)) (checkModuleNameConvention mod)) Nothing)] + -- | Validate a package against the given ValidationProfile, accumulating findings into a ValidationResult. Errors hard-stop traversal once maxErrors is reached. package :: Validation.ValidationProfile -> Validation.ValidationResult ErrorPackaging.InvalidPackageError -> Packaging.Package -> Validation.ValidationResult ErrorPackaging.InvalidPackageError package p acc0 pkg = diff --git a/src/main/haskell/Hydra/Validation.hs b/src/main/haskell/Hydra/Validation.hs --- a/src/main/haskell/Hydra/Validation.hs +++ b/src/main/haskell/Hydra/Validation.hs @@ -1,12 +1,15 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Framework types for configurable validation: profiles classify checks as errors or warnings, and results accumulate findings up to caller-specified bounds. module Hydra.Validation where + import qualified Hydra.Core as Core import qualified Hydra.Error.Core as ErrorCore import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci import qualified Data.Set as S + -- | Configuration for a validation pass: which check rules are active, how each is classified, and the upper bounds on collected findings. A check whose rule name appears in neither set is never evaluated. Errors hard-stop the traversal once maxErrors is reached; warnings only stop being collected once maxWarnings is reached, never causing termination. data ValidationProfile = ValidationProfile { @@ -19,11 +22,17 @@ -- | Soft upper bound on collected warnings. Once the warnings list reaches this length, further warning matches are silently dropped, but validation does not terminate; it continues until maxErrors is reached or the traversal completes. validationProfileMaxWarnings :: Int} deriving (Eq, Ord, Read, Show) + _ValidationProfile = Core.Name "hydra.validation.ValidationProfile" + _ValidationProfile_errorRules = Core.Name "errorRules" + _ValidationProfile_warningRules = Core.Name "warningRules" + _ValidationProfile_maxErrors = Core.Name "maxErrors" + _ValidationProfile_maxWarnings = Core.Name "maxWarnings" + -- | The outcome of a validation pass: an ordered list of error findings and an ordered list of warning findings, each parameterized by the finding payload type. The pass is considered successful when 'errors' is empty; warnings are informational and do not affect that judgement. data ValidationResult e = ValidationResult { @@ -32,6 +41,9 @@ -- | Findings classified as warnings, in traversal order, bounded by the profile's maxWarnings. validationResultWarnings :: [e]} deriving (Eq, Ord, Read, Show) + _ValidationResult = Core.Name "hydra.validation.ValidationResult" + _ValidationResult_errors = Core.Name "errors" + _ValidationResult_warnings = Core.Name "warnings" 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 @@ -1,26 +1,32 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Free variable analysis, term-level substitution, and unshadowing module Hydra.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.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.Haskell.Lib.Equality as Equality -import qualified Hydra.Haskell.Lib.Lists as Lists -import qualified Hydra.Haskell.Lib.Literals as Literals -import qualified Hydra.Haskell.Lib.Logic as Logic -import qualified Hydra.Haskell.Lib.Maps as Maps -import qualified Hydra.Haskell.Lib.Math as Math -import qualified Hydra.Haskell.Lib.Optionals as Optionals -import qualified Hydra.Haskell.Lib.Pairs as Pairs -import qualified Hydra.Haskell.Lib.Sets as Sets -import qualified Hydra.Haskell.Lib.Strings as Strings +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.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.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 @@ -28,8 +34,10 @@ 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 @@ -40,6 +48,7 @@ import qualified Data.Scientific as Sci import qualified Data.Map as M import qualified Data.Set as S + -- | Get the set of free type variables in a term (including schema names, where they appear in type annotations). In this context, only the type schemes of let bindings can bind type variables; type lambdas do not. freeTypeVariablesInTerm :: Core.Term -> S.Set Core.Name freeTypeVariablesInTerm term0 = @@ -65,6 +74,7 @@ Core.TermTypeLambda v0 -> Sets.union (tryType vars (Core.TypeVariable (Core.typeLambdaParameter v0))) (recurse (Core.typeLambdaBody v0)) _ -> dflt in (getAll Sets.empty term0) + -- | Find the free variables (i.e. variables not bound by a lambda or let) in a term freeVariablesInTerm :: Core.Term -> S.Set Core.Name freeVariablesInTerm term = @@ -75,6 +85,7 @@ Core.TermLet v0 -> Sets.difference (dfltVars ()) (Sets.fromList (Lists.map Core.bindingName (Core.letBindings v0))) Core.TermVariable v0 -> Sets.singleton v0 _ -> dfltVars () + -- | Find the free variables (i.e. variables not bound by a lambda or let) in a type freeVariablesInType :: Core.Type -> S.Set Core.Name freeVariablesInType typ = @@ -84,6 +95,7 @@ Core.TypeForall v0 -> Sets.delete (Core.forallTypeParameter v0) (freeVariablesInType (Core.forallTypeBody v0)) Core.TypeVariable v0 -> Sets.singleton v0 _ -> dfltVars + -- | Find the free variables in a type in deterministic left-to-right order freeVariablesInTypeOrdered :: Core.Type -> [Core.Name] freeVariablesInTypeOrdered typ = @@ -95,6 +107,7 @@ 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)) + -- | Find free variables in a type scheme freeVariablesInTypeScheme :: Core.TypeScheme -> S.Set Core.Name freeVariablesInTypeScheme ts = @@ -102,6 +115,7 @@ let vars = Core.typeSchemeVariables ts t = Core.typeSchemeBody ts in (Sets.difference (freeVariablesInType t) (Sets.fromList vars)) + -- | Find free variables in a type scheme (simple version) freeVariablesInTypeSchemeSimple :: Core.TypeScheme -> S.Set Core.Name freeVariablesInTypeSchemeSimple ts = @@ -109,6 +123,7 @@ let vars = Core.typeSchemeVariables ts t = Core.typeSchemeBody ts in (Sets.difference (freeVariablesInTypeSimple t) (Sets.fromList vars)) + -- | Same as freeVariablesInType, but ignores the binding action of lambda types freeVariablesInTypeSimple :: Core.Type -> S.Set Core.Name freeVariablesInTypeSimple typ = @@ -118,9 +133,11 @@ Core.TypeVariable v0 -> Sets.insert v0 types _ -> types in (Rewriting.foldOverType Coders.TraversalOrderPre helper Sets.empty typ) + -- | Check whether a variable is free (not bound) in a term isFreeVariableInTerm :: Core.Name -> Core.Term -> Bool isFreeVariableInTerm v term = Logic.not (Sets.member v (freeVariablesInTerm term)) + -- | Recursively replace the type variables of let bindings with the systematic type variables t0, t1, t2, ... normalizeTypeVariablesInTerm :: Core.Term -> Core.Term normalizeTypeVariablesInTerm term = @@ -207,6 +224,7 @@ _ -> recurse term2 in (Rewriting.rewriteTerm rewrite term0) in (rewriteWithSubst ((Maps.empty, Sets.empty), 0) term) + -- | Replace a free variable in a term replaceFreeTermVariable :: Core.Name -> Core.Term -> Core.Term -> Core.Term replaceFreeTermVariable vold tnew term = @@ -219,6 +237,7 @@ Core.TermVariable v0 -> Logic.ifElse (Equality.equal v0 vold) tnew (Core.TermVariable v0) _ -> recurse t in (Rewriting.rewriteTerm rewrite term) + -- | Replace free occurrences of a name in a type replaceFreeTypeVariable :: Core.Name -> Core.Type -> Core.Type -> Core.Type replaceFreeTypeVariable v rep typ = @@ -231,6 +250,7 @@ Core.TypeVariable v0 -> Logic.ifElse (Equality.equal v v0) rep t _ -> recurse t in (Rewriting.rewriteType mapExpr typ) + -- | Substitute type variables in a type substituteTypeVariables :: M.Map Core.Name Core.Name -> Core.Type -> Core.Type substituteTypeVariables subst typ = @@ -240,6 +260,7 @@ Core.TypeVariable v0 -> Core.TypeVariable (Optionals.fromOptional v0 (Maps.lookup v0 subst)) _ -> recurse typ2 in (Rewriting.rewriteType replace typ) + -- | Substitute one variable for another in a term substituteVariable :: Core.Name -> Core.Name -> Core.Term -> Core.Term substituteVariable from to term = @@ -250,6 +271,7 @@ Core.TermLambda v0 -> Logic.ifElse (Equality.equal (Core.lambdaParameter v0) from) term2 (recurse term2) _ -> recurse term2 in (Rewriting.rewriteTerm replace term) + -- | Substitute multiple variables in a term substituteVariables :: M.Map Core.Name Core.Name -> Core.Term -> Core.Term substituteVariables subst term = @@ -260,6 +282,7 @@ Core.TermLambda v0 -> Optionals.cases (Maps.lookup (Core.lambdaParameter v0) subst) (recurse term2) (\_ -> term2) _ -> recurse term2 in (Rewriting.rewriteTerm replace term) + -- | Rename all shadowed variables (both lambda parameters and let-bound variables that shadow lambda parameters) in a term. unshadowVariables :: Core.Term -> Core.Term unshadowVariables term0 = diff --git a/src/main/haskell/Hydra/Variants.hs b/src/main/haskell/Hydra/Variants.hs --- a/src/main/haskell/Hydra/Variants.hs +++ b/src/main/haskell/Hydra/Variants.hs @@ -1,10 +1,13 @@ -- Note: this is an automatically generated file. Do not edit. + -- | Variant types which describe the structure of Hydra core types and terms. module Hydra.Variants where + import qualified Hydra.Core as Core import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci + -- | The identifier of a literal constructor data LiteralVariant = LiteralVariantBinary | @@ -14,13 +17,21 @@ LiteralVariantInteger | LiteralVariantString deriving (Eq, Ord, Read, Show) + _LiteralVariant = Core.Name "hydra.variants.LiteralVariant" + _LiteralVariant_binary = Core.Name "binary" + _LiteralVariant_boolean = Core.Name "boolean" + _LiteralVariant_decimal = Core.Name "decimal" + _LiteralVariant_float = Core.Name "float" + _LiteralVariant_integer = Core.Name "integer" + _LiteralVariant_string = Core.Name "string" + -- | The identifier of a term expression constructor data TermVariant = TermVariantAnnotated | @@ -45,32 +56,56 @@ TermVariantVariable | TermVariantWrap deriving (Eq, Ord, Read, Show) + _TermVariant = Core.Name "hydra.variants.TermVariant" + _TermVariant_annotated = Core.Name "annotated" + _TermVariant_application = Core.Name "application" + _TermVariant_cases = Core.Name "cases" + _TermVariant_either = Core.Name "either" + _TermVariant_inject = Core.Name "inject" + _TermVariant_lambda = Core.Name "lambda" + _TermVariant_let = Core.Name "let" + _TermVariant_list = Core.Name "list" + _TermVariant_literal = Core.Name "literal" + _TermVariant_map = Core.Name "map" + _TermVariant_optional = Core.Name "optional" + _TermVariant_pair = Core.Name "pair" + _TermVariant_project = Core.Name "project" + _TermVariant_record = Core.Name "record" + _TermVariant_set = Core.Name "set" + _TermVariant_typeApplication = Core.Name "typeApplication" + _TermVariant_typeLambda = Core.Name "typeLambda" + _TermVariant_unit = Core.Name "unit" + _TermVariant_unwrap = Core.Name "unwrap" + _TermVariant_variable = Core.Name "variable" + _TermVariant_wrap = Core.Name "wrap" + -- | The identifier of a type constructor data TypeVariant = TypeVariantAnnotated | TypeVariantApplication | + TypeVariantEffect | TypeVariantEither | TypeVariantForall | TypeVariantFunction | @@ -87,21 +122,41 @@ TypeVariantVoid | TypeVariantWrap deriving (Eq, Ord, Read, Show) + _TypeVariant = Core.Name "hydra.variants.TypeVariant" + _TypeVariant_annotated = Core.Name "annotated" + _TypeVariant_application = Core.Name "application" + +_TypeVariant_effect = Core.Name "effect" + _TypeVariant_either = Core.Name "either" + _TypeVariant_forall = Core.Name "forall" + _TypeVariant_function = Core.Name "function" + _TypeVariant_list = Core.Name "list" + _TypeVariant_literal = Core.Name "literal" + _TypeVariant_map = Core.Name "map" + _TypeVariant_optional = Core.Name "optional" + _TypeVariant_pair = Core.Name "pair" + _TypeVariant_record = Core.Name "record" + _TypeVariant_set = Core.Name "set" + _TypeVariant_union = Core.Name "union" + _TypeVariant_unit = Core.Name "unit" + _TypeVariant_variable = Core.Name "variable" + _TypeVariant_void = Core.Name "void" + _TypeVariant_wrap = Core.Name "wrap" diff --git a/src/main/haskell/Hydra/Yaml/Model.hs b/src/main/haskell/Hydra/Yaml/Model.hs --- a/src/main/haskell/Hydra/Yaml/Model.hs +++ b/src/main/haskell/Hydra/Yaml/Model.hs @@ -1,4 +1,5 @@ -- Note: this is an automatically generated file. Do not edit. + -- | A basic YAML representation model. Based on: -- | https://yaml.org/spec/1.2/spec.html -- | The Serialization and Presentation properties of YAML, @@ -6,10 +7,12 @@ -- | In addition, tags are omitted from this model, and non-standard scalars are unsupported. module Hydra.Yaml.Model 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 YAML node (value) data Node = -- | A mapping from nodes to nodes @@ -19,10 +22,15 @@ -- | A sequence of nodes NodeSequence [Node] deriving (Eq, Ord, Read, Show) + _Node = Core.Name "hydra.yaml.model.Node" + _Node_mapping = Core.Name "mapping" + _Node_scalar = Core.Name "scalar" + _Node_sequence = Core.Name "sequence" + -- | A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here data Scalar = -- | Represents a true/false value @@ -38,10 +46,17 @@ -- | A string value ScalarStr String deriving (Eq, Ord, Read, Show) + _Scalar = Core.Name "hydra.yaml.model.Scalar" + _Scalar_bool = Core.Name "bool" + _Scalar_decimal = Core.Name "decimal" + _Scalar_float = Core.Name "float" + _Scalar_int = Core.Name "int" + _Scalar_null = Core.Name "null" + _Scalar_str = Core.Name "str"