hydra-kernel 0.17.3 → 0.17.4
raw patch · 31 files changed
+2455/−207 lines, 31 files
Files
- CHANGELOG.md +40/−0
- hydra-kernel.cabal +5/−1
- src/main/haskell/Hydra/Classes.hs +12/−0
- src/main/haskell/Hydra/Codegen.hs +4/−4
- src/main/haskell/Hydra/Decode/Error/Core.hs +90/−0
- src/main/haskell/Hydra/Decode/Regex.hs +1/−0
- src/main/haskell/Hydra/Dsl/Error/Core.hs +785/−0
- src/main/haskell/Hydra/Dsl/Json/Decode.hs +11/−7
- src/main/haskell/Hydra/Dsl/Json/Encode.hs +11/−7
- src/main/haskell/Hydra/Dsl/Lib/Effects.hs +149/−0
- src/main/haskell/Hydra/Dsl/Lib/Files.hs +157/−0
- src/main/haskell/Hydra/Dsl/Lib/Math.hs +20/−11
- src/main/haskell/Hydra/Dsl/Lib/System.hs +118/−0
- src/main/haskell/Hydra/Dsl/Lib/Text.hs +80/−0
- src/main/haskell/Hydra/Dsl/Regex.hs +1/−0
- src/main/haskell/Hydra/Dsl/Resolution.hs +18/−0
- src/main/haskell/Hydra/Encode/Error/Core.hs +126/−0
- src/main/haskell/Hydra/Encode/Regex.hs +1/−0
- src/main/haskell/Hydra/Error/Core.hs +138/−0
- src/main/haskell/Hydra/Json/Decode.hs +51/−31
- src/main/haskell/Hydra/Json/Encode.hs +37/−21
- src/main/haskell/Hydra/Json/Yaml/Decode.hs +1/−1
- src/main/haskell/Hydra/Json/Yaml/Encode.hs +1/−1
- src/main/haskell/Hydra/Lib/Defaults.hs +0/−18
- src/main/haskell/Hydra/Lib/Math.hs +126/−69
- src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs +216/−14
- src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs +14/−7
- src/main/haskell/Hydra/Print/Error/Core.hs +77/−0
- src/main/haskell/Hydra/Resolution.hs +19/−0
- src/main/haskell/Hydra/Unification.hs +16/−5
- src/main/haskell/Hydra/Validate/Core.hs +130/−10
CHANGELOG.md view
@@ -15,6 +15,46 @@ --- +## [0.17.3] - 2026-08-01++Point release on the 0.17.x line, focused on **release-artifact integrity**. The 0.17.2 release shipped+two defects that every existing check missed because they validated only the generated `dist/` tree, never+the packaged artifact: the `hydra-build` sdist shipped 3 of 8 modules, and the published Java `hydra-kernel`+jar was a whole [#417](https://github.com/CategoricalData/hydra/issues/417) rename behind. This release adds+an artifact-level publish-completeness gate that inspects the actual uploaded archive, closing that class of+defect across all five registries.++### Highlights++- **Artifact-content completeness gate** ([#621](https://github.com/CategoricalData/hydra/issues/621)):+ every publish path (Hackage sdist, Maven-Java jar, Maven-Scala jar, PyPI wheel, npm tarball) now inspects+ the *packaged* archive and hard-fails if any module a package's manifest declares is missing. The gate also+ asserts the post-#417 class names are present in the Java kernel jar.++### Bug fixes++- **PyPI wheels dropped non-`hydra.*` roots** ([#621](https://github.com/CategoricalData/hydra/issues/621)):+ the wheel packaging hardcoded `packages = ["src/main/python/hydra"]`, silently omitting `hydra-pg`'s+ `com.gdblab.*` and `openGql.*` modules. The generator now ships every emitted top-level root.++### Improvements++- **CI guard for dist-tree completeness** ([#524](https://github.com/CategoricalData/hydra/issues/524)):+ asserts every manifest `mainModules` namespace is emitted into `dist/haskell`, catching the 0.17.2+ `hydra-build` truncation at the tree level (the artifact gate is the packaged-archive counterpart).+- **Manifest generation extracted** into `Hydra.ManifestGeneration`, and the structurally-unneeded #607+ sed shims dropped ([#622](https://github.com/CategoricalData/hydra/issues/622)).+- **Release-verification signing fix** ([#441](https://github.com/CategoricalData/hydra/issues/441)):+ sign the reproducible uncompressed `.tar` and verify the `.asc` against the GitHub Release asset.+- **Java CI signing gate** ([#591](https://github.com/CategoricalData/hydra/issues/591)): `publishToMavenLocal`+ skips gpg signing when no key is present.++### Internal++- Version bump to 0.17.3; `hostVersion` advanced to 0.17.2 and the temporary #417 Java/Python local-host+ shims removed now that 0.17.2 is published on the registries+ ([#417](https://github.com/CategoricalData/hydra/issues/417)).+ ## [0.17.2] - 2026-07-28 Point release on the 0.17.x line. Themes: promotion of the generator's routing and manifest
hydra-kernel.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-kernel-version: 0.17.3+version: 0.17.4 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@@ -104,8 +104,10 @@ Hydra.Dsl.Lexical Hydra.Dsl.Lib.Chars Hydra.Dsl.Lib.Defaults+ Hydra.Dsl.Lib.Effects Hydra.Dsl.Lib.Eithers Hydra.Dsl.Lib.Equality+ Hydra.Dsl.Lib.Files Hydra.Dsl.Lib.Functions Hydra.Dsl.Lib.Lists Hydra.Dsl.Lib.Literals@@ -118,6 +120,8 @@ Hydra.Dsl.Lib.Regex Hydra.Dsl.Lib.Sets Hydra.Dsl.Lib.Strings+ Hydra.Dsl.Lib.System+ Hydra.Dsl.Lib.Text Hydra.Dsl.Names Hydra.Dsl.Packaging Hydra.Dsl.Parsing
src/main/haskell/Hydra/Classes.hs view
@@ -41,6 +41,18 @@ equality = Typing.TypeClass { Typing.typeClassDescription = "Equality: instances support structural equality."} +-- | The fractional type class: instances support total floating-point division.+fractional :: Typing.TypeClass+fractional =+ Typing.TypeClass {+ Typing.typeClassDescription = "Fractional: instances support total floating-point division."}++-- | The integral type class: instances support integer division, modulus, remainder, and parity.+integral :: Typing.TypeClass+integral =+ Typing.TypeClass {+ Typing.typeClassDescription = "Integral: instances support integer division, modulus, remainder, and parity."}+ -- | The numeric type class: instances support arithmetic (addition, subtraction, multiplication, negation). numeric :: Typing.TypeClass numeric =
src/main/haskell/Hydra/Codegen.hs view
@@ -80,7 +80,7 @@ let graph = modulesToGraph bsGraph universeModules universeModules 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))+ 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 False (Core.Name "hydra.packaging.Module") modType jsonVal)) -- | Escape unescaped control characters inside JSON string literals escapeControlCharsInJson :: [Int] -> [Int]@@ -211,7 +211,7 @@ Core.bindingTerm = (Packaging.termDefinitionBody v0), Core.bindingTypeScheme = (Optionals.map Scoping.termSignatureToTypeScheme (Packaging.termDefinitionSignature v0))}) _ -> Nothing) (Packaging.moduleDefinitions mod))))) modsToGenerate- closureMods = moduleDepsTransitive namespaceMap modsToGenerate+ closureMods = moduleDepsTransitive namespaceMap (Lists.concat2 universeModules modsToGenerate) schemaElements = Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ ->@@ -473,7 +473,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)))+ in (Eithers.map (\json -> Writer.printJson json) (Eithers.bimap (\_e -> Errors.ErrorOther (Errors.OtherError _e)) (\_a -> _a) (Encode.toJson schemaMap False (Core.Name "hydra.packaging.Module") modType term))) -- | Convert a generated Module into a Source module moduleToSourceModule :: Packaging.Module -> Packaging.Module@@ -510,7 +510,7 @@ modulesToGraph bsGraph universeModules modules = let universe = Maps.fromList (Lists.map (\m -> (Packaging.moduleName m, m)) (Lists.concat2 universeModules modules))- closureModules = moduleDepsTransitive universe modules+ closureModules = moduleDepsTransitive universe (Lists.concat2 universeModules modules) schemaElements = Lists.concat (Lists.map (\m -> Optionals.givens (Lists.map (\d -> case d of Packaging.DefinitionType v0 -> Just ((\name -> \typ ->
src/main/haskell/Hydra/Decode/Error/Core.hs view
@@ -152,6 +152,18 @@ 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.ExtraRecordFieldsError+extraRecordFieldsError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.ExtraRecordFieldsError+extraRecordFieldsError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "fieldNames" (ExtractCore.decodeList DecodeCore.name) fieldMap cx) (\field_fieldNames -> Right (ErrorCore.ExtraRecordFieldsError {+ ErrorCore.extraRecordFieldsErrorLocation = field_location,+ ErrorCore.extraRecordFieldsErrorTypeName = field_typeName,+ ErrorCore.extraRecordFieldsErrorFieldNames = field_fieldNames})))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.ExtraRecordFieldsError")) (ExtractCore.stripWithDecodingError cx raw)+ -- | Decoder for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.InvalidForallParameterNameError invalidForallParameterNameError cx raw =@@ -236,6 +248,9 @@ Core.Name "emptyTypeNameInTerm", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorEmptyTypeNameInTerm t) (emptyTypeNameInTermError cx input))), (+ Core.Name "extraRecordFields",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorExtraRecordFields t) (extraRecordFieldsError cx input))),+ ( Core.Name "invalidLambdaParameterName", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorInvalidLambdaParameterName t) (invalidLambdaParameterNameError cx input))), (@@ -248,9 +263,15 @@ Core.Name "missingCaseBranches", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorMissingCaseBranches t) (missingCaseBranchesError cx input))), (+ Core.Name "missingRecordFields",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorMissingRecordFields t) (missingRecordFieldsError cx input))),+ ( Core.Name "nestedTermAnnotation", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorNestedTermAnnotation t) (nestedTermAnnotationError cx input))), (+ Core.Name "nominalTypeKindMismatch",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorNominalTypeKindMismatch t) (nominalTypeKindMismatchError cx input))),+ ( Core.Name "redundantWrapUnwrap", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorRedundantWrapUnwrap t) (redundantWrapUnwrapError cx input))), (@@ -263,6 +284,9 @@ Core.Name "typeVariableShadowingInTypeLambda", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorTypeVariableShadowingInTypeLambda t) (typeVariableShadowingInTypeLambdaError cx input))), (+ Core.Name "undeclaredVariant",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUndeclaredVariant t) (undeclaredVariantError cx input))),+ ( Core.Name "undefinedTermVariable", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUndefinedTermVariable t) (undefinedTermVariableError cx input))), (@@ -281,9 +305,15 @@ Core.Name "unknownPrimitiveName", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnknownPrimitiveName t) (unknownPrimitiveNameError cx input))), (+ Core.Name "unknownProjectedField",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnknownProjectedField t) (unknownProjectedFieldError cx input))),+ ( Core.Name "unnecessaryIdentityApplication", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnnecessaryIdentityApplication t) (unnecessaryIdentityApplicationError cx input))), (+ Core.Name "unresolvedNominalType",+ (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUnresolvedNominalType t) (unresolvedNominalTypeError cx input))),+ ( Core.Name "untypedTermVariable", (\input -> Eithers.map (\t -> ErrorCore.InvalidTermErrorUntypedTermVariable t) (untypedTermVariableError cx input)))] in (Optionals.cases (Maps.lookup fname variantMap) (Left (Errors.DecodingError (Strings.concat [@@ -395,6 +425,18 @@ ErrorCore.missingCaseBranchesErrorVariantNames = field_variantNames}))))) _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.MissingCaseBranchesError")) (ExtractCore.stripWithDecodingError cx raw) +-- | Decoder for hydra.error.core.MissingRecordFieldsError+missingRecordFieldsError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.MissingRecordFieldsError+missingRecordFieldsError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "fieldNames" (ExtractCore.decodeList DecodeCore.name) fieldMap cx) (\field_fieldNames -> Right (ErrorCore.MissingRecordFieldsError {+ ErrorCore.missingRecordFieldsErrorLocation = field_location,+ ErrorCore.missingRecordFieldsErrorTypeName = field_typeName,+ ErrorCore.missingRecordFieldsErrorFieldNames = field_fieldNames})))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.MissingRecordFieldsError")) (ExtractCore.stripWithDecodingError cx raw)+ -- | Decoder for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NestedTermAnnotationError nestedTermAnnotationError cx raw =@@ -415,6 +457,19 @@ 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.NominalTypeKindMismatchError+nominalTypeKindMismatchError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "expectedVariant" Variants.typeVariant fieldMap cx) (\field_expectedVariant -> Eithers.bind (ExtractCore.requireField "actualVariant" Variants.typeVariant fieldMap cx) (\field_actualVariant -> Right (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = field_location,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = field_typeName,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = field_expectedVariant,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = field_actualVariant}))))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.NominalTypeKindMismatchError")) (ExtractCore.stripWithDecodingError cx raw)+ -- | Decoder for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeError cx raw =@@ -503,6 +558,18 @@ 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.UndeclaredVariantError+undeclaredVariantError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndeclaredVariantError+undeclaredVariantError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "variantName" DecodeCore.name fieldMap cx) (\field_variantName -> Right (ErrorCore.UndeclaredVariantError {+ ErrorCore.undeclaredVariantErrorLocation = field_location,+ ErrorCore.undeclaredVariantErrorTypeName = field_typeName,+ ErrorCore.undeclaredVariantErrorVariantName = field_variantName})))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UndeclaredVariantError")) (ExtractCore.stripWithDecodingError cx raw)+ -- | Decoder for hydra.error.core.UndefinedFieldError undefinedFieldError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UndefinedFieldError undefinedFieldError cx raw =@@ -614,6 +681,18 @@ 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.UnknownProjectedFieldError+unknownProjectedFieldError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Eithers.bind (ExtractCore.requireField "fieldName" DecodeCore.name fieldMap cx) (\field_fieldName -> Right (ErrorCore.UnknownProjectedFieldError {+ ErrorCore.unknownProjectedFieldErrorLocation = field_location,+ ErrorCore.unknownProjectedFieldErrorTypeName = field_typeName,+ ErrorCore.unknownProjectedFieldErrorFieldName = field_fieldName})))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnknownProjectedFieldError")) (ExtractCore.stripWithDecodingError cx raw)+ -- | Decoder for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError cx raw =@@ -623,6 +702,17 @@ 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.UnresolvedNominalTypeError+unresolvedNominalTypeError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UnresolvedNominalTypeError+unresolvedNominalTypeError cx raw =+ Eithers.either (\err -> Left err) (\stripped -> case stripped of+ Core.TermRecord v0 ->+ let fieldMap = ExtractCore.toFieldMap v0+ in (Eithers.bind (ExtractCore.requireField "location" Paths.subtermPath fieldMap cx) (\field_location -> Eithers.bind (ExtractCore.requireField "typeName" DecodeCore.name fieldMap cx) (\field_typeName -> Right (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = field_location,+ ErrorCore.unresolvedNominalTypeErrorTypeName = field_typeName}))))+ _ -> Left (Errors.DecodingError "expected a record of type hydra.error.core.UnresolvedNominalTypeError")) (ExtractCore.stripWithDecodingError cx raw) -- | Decoder for hydra.error.core.UntypedTermVariableError untypedTermVariableError :: Graph.Graph -> Core.Term -> Either Errors.DecodingError ErrorCore.UntypedTermVariableError
src/main/haskell/Hydra/Decode/Regex.hs view
@@ -5,6 +5,7 @@ module Hydra.Decode.Regex 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
src/main/haskell/Hydra/Dsl/Error/Core.hs view
@@ -631,6 +631,125 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL constructor for hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.ExtraRecordFieldsError+extraRecordFieldsError location typeName fieldNames =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Typed.unTypedTerm fieldNames)}]}))++-- | DSL name token for hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorExtraRecordFieldsError :: Typed.TypedName ErrorCore.ExtraRecordFieldsError+extraRecordFieldsErrorExtraRecordFieldsError = Typed.TypedName (Core.Name "hydra.error.core.ExtraRecordFieldsError")++-- | DSL accessor for the fieldNames field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorFieldNames :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm [Core.Name]+extraRecordFieldsErrorFieldNames x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the location field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorLocation :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm Paths.SubtermPath+extraRecordFieldsErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the typeName field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorTypeName :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm Core.Name+extraRecordFieldsErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL updater for the fieldNames field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorWithFieldNames :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.ExtraRecordFieldsError+extraRecordFieldsErrorWithFieldNames original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)}]}))++-- | DSL updater for the location field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorWithLocation :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.ExtraRecordFieldsError+extraRecordFieldsErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsErrorWithTypeName :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.ExtraRecordFieldsError+extraRecordFieldsErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))+ -- | DSL constructor for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.InvalidForallParameterNameError invalidForallParameterNameError location name =@@ -917,6 +1036,15 @@ Core.fieldName = (Core.Name "emptyTypeNameInTerm"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the extraRecordFields variant of hydra.error.core.InvalidTermError+invalidTermErrorExtraRecordFields :: Typed.TypedTerm ErrorCore.ExtraRecordFieldsError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorExtraRecordFields x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "extraRecordFields"),+ 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 =@@ -957,6 +1085,15 @@ Core.fieldName = (Core.Name "missingCaseBranches"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the missingRecordFields variant of hydra.error.core.InvalidTermError+invalidTermErrorMissingRecordFields :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorMissingRecordFields x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "missingRecordFields"),+ 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 =@@ -966,6 +1103,15 @@ Core.fieldName = (Core.Name "nestedTermAnnotation"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the nominalTypeKindMismatch variant of hydra.error.core.InvalidTermError+invalidTermErrorNominalTypeKindMismatch :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorNominalTypeKindMismatch x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "nominalTypeKindMismatch"),+ 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 =@@ -1002,6 +1148,15 @@ Core.fieldName = (Core.Name "typeVariableShadowingInTypeLambda"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the undeclaredVariant variant of hydra.error.core.InvalidTermError+invalidTermErrorUndeclaredVariant :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorUndeclaredVariant x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "undeclaredVariant"),+ 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 =@@ -1056,6 +1211,15 @@ Core.fieldName = (Core.Name "unknownPrimitiveName"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the unknownProjectedField variant of hydra.error.core.InvalidTermError+invalidTermErrorUnknownProjectedField :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorUnknownProjectedField x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "unknownProjectedField"),+ 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 =@@ -1065,6 +1229,15 @@ Core.fieldName = (Core.Name "unnecessaryIdentityApplication"), Core.fieldTerm = (Typed.unTypedTerm x)}})) +-- | DSL injection for the unresolvedNominalType variant of hydra.error.core.InvalidTermError+invalidTermErrorUnresolvedNominalType :: Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError -> Typed.TypedTerm ErrorCore.InvalidTermError+invalidTermErrorUnresolvedNominalType x =+ Typed.TypedTerm (Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "unresolvedNominalType"),+ 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 =@@ -1532,6 +1705,125 @@ Core.fieldName = (Core.Name "variantNames"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL constructor for hydra.error.core.MissingRecordFieldsError+missingRecordFieldsError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.MissingRecordFieldsError+missingRecordFieldsError location typeName fieldNames =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Typed.unTypedTerm fieldNames)}]}))++-- | DSL accessor for the fieldNames field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorFieldNames :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm [Core.Name]+missingRecordFieldsErrorFieldNames x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the location field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorLocation :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm Paths.SubtermPath+missingRecordFieldsErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL name token for hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorMissingRecordFieldsError :: Typed.TypedName ErrorCore.MissingRecordFieldsError+missingRecordFieldsErrorMissingRecordFieldsError = Typed.TypedName (Core.Name "hydra.error.core.MissingRecordFieldsError")++-- | DSL accessor for the typeName field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorTypeName :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm Core.Name+missingRecordFieldsErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL updater for the fieldNames field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorWithFieldNames :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm [Core.Name] -> Typed.TypedTerm ErrorCore.MissingRecordFieldsError+missingRecordFieldsErrorWithFieldNames original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)}]}))++-- | DSL updater for the location field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorWithLocation :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.MissingRecordFieldsError+missingRecordFieldsErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.MissingRecordFieldsError+missingRecordFieldsErrorWithTypeName :: Typed.TypedTerm ErrorCore.MissingRecordFieldsError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.MissingRecordFieldsError+missingRecordFieldsErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.projectionFieldName = (Core.Name "fieldNames")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))+ -- | DSL constructor for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NestedTermAnnotationError nestedTermAnnotationError location =@@ -1600,6 +1892,190 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL constructor for hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchError location typeName expectedVariant actualVariant =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Typed.unTypedTerm expectedVariant)},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Typed.unTypedTerm actualVariant)}]}))++-- | DSL accessor for the actualVariant field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorActualVariant :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Variants.TypeVariant+nominalTypeKindMismatchErrorActualVariant x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "actualVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the expectedVariant field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorExpectedVariant :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Variants.TypeVariant+nominalTypeKindMismatchErrorExpectedVariant x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "expectedVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the location field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorLocation :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Paths.SubtermPath+nominalTypeKindMismatchErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL name token for hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorNominalTypeKindMismatchError :: Typed.TypedName ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorNominalTypeKindMismatchError =+ Typed.TypedName (Core.Name "hydra.error.core.NominalTypeKindMismatchError")++-- | DSL accessor for the typeName field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorTypeName :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Core.Name+nominalTypeKindMismatchErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL updater for the actualVariant field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithActualVariant :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithActualVariant original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "expectedVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)}]}))++-- | DSL updater for the expectedVariant field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithExpectedVariant :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Variants.TypeVariant -> Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithExpectedVariant original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "actualVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the location field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithLocation :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "expectedVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "actualVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithTypeName :: Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.NominalTypeKindMismatchError+nominalTypeKindMismatchErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "expectedVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.projectionFieldName = (Core.Name "actualVariant")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))+ -- | DSL constructor for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Type -> Typed.TypedTerm ErrorCore.NonComparableMapKeyTypeError nonComparableMapKeyTypeError location keyType =@@ -2157,6 +2633,125 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL constructor for hydra.error.core.UndeclaredVariantError+undeclaredVariantError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndeclaredVariantError+undeclaredVariantError location typeName variantName =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)},+ Core.Field {+ Core.fieldName = (Core.Name "variantName"),+ Core.fieldTerm = (Typed.unTypedTerm variantName)}]}))++-- | DSL accessor for the location field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorLocation :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Paths.SubtermPath+undeclaredVariantErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the typeName field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorTypeName :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Core.Name+undeclaredVariantErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL name token for hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorUndeclaredVariantError :: Typed.TypedName ErrorCore.UndeclaredVariantError+undeclaredVariantErrorUndeclaredVariantError = Typed.TypedName (Core.Name "hydra.error.core.UndeclaredVariantError")++-- | DSL accessor for the variantName field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorVariantName :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Core.Name+undeclaredVariantErrorVariantName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "variantName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL updater for the location field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorWithLocation :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UndeclaredVariantError+undeclaredVariantErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "variantName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "variantName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorWithTypeName :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndeclaredVariantError+undeclaredVariantErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "variantName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "variantName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the variantName field of hydra.error.core.UndeclaredVariantError+undeclaredVariantErrorWithVariantName :: Typed.TypedTerm ErrorCore.UndeclaredVariantError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UndeclaredVariantError+undeclaredVariantErrorWithVariantName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "variantName"),+ 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 =@@ -2906,6 +3501,126 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) +-- | DSL constructor for hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldError location typeName fieldName =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldName"),+ Core.fieldTerm = (Typed.unTypedTerm fieldName)}]}))++-- | DSL accessor for the fieldName field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorFieldName :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Core.Name+unknownProjectedFieldErrorFieldName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "fieldName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the location field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorLocation :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Paths.SubtermPath+unknownProjectedFieldErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the typeName field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorTypeName :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Core.Name+unknownProjectedFieldErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL name token for hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorUnknownProjectedFieldError :: Typed.TypedName ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldErrorUnknownProjectedFieldError =+ Typed.TypedName (Core.Name "hydra.error.core.UnknownProjectedFieldError")++-- | DSL updater for the fieldName field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorWithFieldName :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldErrorWithFieldName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)}]}))++-- | DSL updater for the location field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorWithLocation :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "fieldName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldErrorWithTypeName :: Typed.TypedTerm ErrorCore.UnknownProjectedFieldError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnknownProjectedFieldError+unknownProjectedFieldErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "fieldName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.projectionFieldName = (Core.Name "fieldName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))+ -- | DSL constructor for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError location =@@ -2938,6 +3653,76 @@ Core.recordFields = [ Core.Field { Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)}]}))++-- | DSL constructor for hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeError :: Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError+unresolvedNominalTypeError location typeName =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm location)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Typed.unTypedTerm typeName)}]}))++-- | DSL accessor for the location field of hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeErrorLocation :: Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError -> Typed.TypedTerm Paths.SubtermPath+unresolvedNominalTypeErrorLocation x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL accessor for the typeName field of hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeErrorTypeName :: Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError -> Typed.TypedTerm Core.Name+unresolvedNominalTypeErrorTypeName x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL name token for hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeErrorUnresolvedNominalTypeError :: Typed.TypedName ErrorCore.UnresolvedNominalTypeError+unresolvedNominalTypeErrorUnresolvedNominalTypeError =+ Typed.TypedName (Core.Name "hydra.error.core.UnresolvedNominalTypeError")++-- | DSL updater for the location field of hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeErrorWithLocation :: Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError -> Typed.TypedTerm Paths.SubtermPath -> Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError+unresolvedNominalTypeErrorWithLocation original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Typed.unTypedTerm newVal)},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.projectionFieldName = (Core.Name "typeName")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))}]}))++-- | DSL updater for the typeName field of hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeErrorWithTypeName :: Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError -> Typed.TypedTerm Core.Name -> Typed.TypedTerm ErrorCore.UnresolvedNominalTypeError+unresolvedNominalTypeErrorWithTypeName original newVal =+ Typed.TypedTerm (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermProject (Core.Projection {+ Core.projectionTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.projectionFieldName = (Core.Name "location")})),+ Core.applicationArgument = (Typed.unTypedTerm original)}))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) -- | DSL constructor for hydra.error.core.UntypedTermVariableError
src/main/haskell/Hydra/Dsl/Json/Decode.hs view
@@ -27,6 +27,7 @@ import qualified Hydra.Dsl.Query as DslQuery import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.Resolution as DslResolution import qualified Hydra.Dsl.Strip as DslStrip import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular@@ -56,6 +57,7 @@ import qualified Hydra.Query as Query import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational+import qualified Hydra.Resolution as Resolution import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System@@ -128,17 +130,19 @@ Core.applicationArgument = (Typed.unTypedTerm arg0)})) -- | DSL reference to hydra.json.decode.fromJson-fromJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term)-fromJson arg0 arg1 arg2 arg3 =+fromJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Model.Value -> Typed.TypedTerm (Either String Core.Term)+fromJson arg0 arg1 arg2 arg3 arg4 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.fromJson")),- Core.applicationArgument = (Typed.unTypedTerm arg0)})),- Core.applicationArgument = (Typed.unTypedTerm arg1)})),- Core.applicationArgument = (Typed.unTypedTerm arg2)})),- Core.applicationArgument = (Typed.unTypedTerm arg3)}))+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.decode.fromJson")),+ Core.applicationArgument = (Typed.unTypedTerm arg0)})),+ Core.applicationArgument = (Typed.unTypedTerm arg1)})),+ Core.applicationArgument = (Typed.unTypedTerm arg2)})),+ Core.applicationArgument = (Typed.unTypedTerm arg3)})),+ Core.applicationArgument = (Typed.unTypedTerm arg4)})) -- | DSL reference to hydra.json.decode.parseSpecialFloat parseSpecialFloat :: Typed.TypedTerm String -> Typed.TypedTerm (Maybe Double)
src/main/haskell/Hydra/Dsl/Json/Encode.hs view
@@ -27,6 +27,7 @@ import qualified Hydra.Dsl.Query as DslQuery import qualified Hydra.Dsl.Regex as DslRegex import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.Resolution as DslResolution import qualified Hydra.Dsl.Strip as DslStrip import qualified Hydra.Dsl.System as DslSystem import qualified Hydra.Dsl.Tabular as DslTabular@@ -56,6 +57,7 @@ import qualified Hydra.Query as Query import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational+import qualified Hydra.Resolution as Resolution import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System@@ -101,17 +103,19 @@ Core.applicationArgument = (Typed.unTypedTerm arg0)})) -- | DSL reference to hydra.json.encode.toJson-toJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Model.Value)-toJson arg0 arg1 arg2 arg3 =+toJson :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Bool -> Typed.TypedTerm Core.Name -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Model.Value)+toJson arg0 arg1 arg2 arg3 arg4 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.toJson")),- Core.applicationArgument = (Typed.unTypedTerm arg0)})),- Core.applicationArgument = (Typed.unTypedTerm arg1)})),- Core.applicationArgument = (Typed.unTypedTerm arg2)})),- Core.applicationArgument = (Typed.unTypedTerm arg3)}))+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.json.encode.toJson")),+ Core.applicationArgument = (Typed.unTypedTerm arg0)})),+ Core.applicationArgument = (Typed.unTypedTerm arg1)})),+ Core.applicationArgument = (Typed.unTypedTerm arg2)})),+ Core.applicationArgument = (Typed.unTypedTerm arg3)})),+ Core.applicationArgument = (Typed.unTypedTerm arg4)})) -- | DSL reference to hydra.json.encode.toJsonUntyped toJsonUntyped :: Typed.TypedTerm Core.Term -> Typed.TypedTerm (Either String Model.Value)
+ src/main/haskell/Hydra/Dsl/Lib/Effects.hs view
@@ -0,0 +1,149 @@+-- Note: this is an automatically generated file. Do not edit.++-- | DSL functions for hydra.lib.effects++module Hydra.Dsl.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.Dsl.Ast as DslAst+import qualified Hydra.Dsl.Coders as DslCoders+import qualified Hydra.Dsl.Core as DslCore+import qualified Hydra.Dsl.Docs as DslDocs+import qualified Hydra.Dsl.Error.Checking as ErrorChecking+import qualified Hydra.Dsl.Error.Core as DslErrorCore+import qualified Hydra.Dsl.Error.File as DslErrorFile+import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging+import qualified Hydra.Dsl.Error.System as DslErrorSystem+import qualified Hydra.Dsl.Errors as DslErrors+import qualified Hydra.Dsl.File as DslFile+import qualified Hydra.Dsl.Graph as DslGraph+import qualified Hydra.Dsl.Json.Model as JsonModel+import qualified Hydra.Dsl.Packaging as DslPackaging+import qualified Hydra.Dsl.Parsing as DslParsing+import qualified Hydra.Dsl.Paths as DslPaths+import qualified Hydra.Dsl.Query as DslQuery+import qualified Hydra.Dsl.Regex as DslRegex+import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.System as DslSystem+import qualified Hydra.Dsl.Tabular as DslTabular+import qualified Hydra.Dsl.Testing as DslTesting+import qualified Hydra.Dsl.Time as DslTime+import qualified Hydra.Dsl.Topology as DslTopology+import qualified Hydra.Dsl.Typing as DslTyping+import qualified Hydra.Dsl.Util as DslUtil+import qualified Hydra.Dsl.Validation as DslValidation+import qualified Hydra.Dsl.Variants as DslVariants+import qualified Hydra.Error.Checking as Checking+import qualified Hydra.Error.Core as ErrorCore+import qualified Hydra.Error.File as ErrorFile+import qualified Hydra.Error.Packaging as ErrorPackaging+import qualified Hydra.Error.System as ErrorSystem+import qualified Hydra.Errors as Errors+import qualified Hydra.File as File+import qualified Hydra.Graph as Graph+import qualified Hydra.Json.Model as Model+import qualified Hydra.Packaging as Packaging+import qualified Hydra.Parsing as Parsing+import qualified Hydra.Paths as Paths+import qualified Hydra.Query as Query+import qualified Hydra.Regex as Regex+import qualified Hydra.Relational as Relational+import qualified Hydra.System as System+import qualified Hydra.Tabular as Tabular+import qualified Hydra.Testing as Testing+import qualified Hydra.Time as Time+import qualified Hydra.Topology as Topology+import qualified Hydra.Typed as Typed+import qualified Hydra.Typing as Typing+import qualified Hydra.Util as Util+import qualified Hydra.Validation as Validation+import qualified Hydra.Variants as Variants+import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)+import qualified Data.Scientific as Sci+import qualified Data.Set as S++-- | DSL reference to hydra.lib.effects.apply+apply :: Typed.TypedTerm (IO (x -> y)) -> Typed.TypedTerm (IO x) -> Typed.TypedTerm (IO y)+apply ef ex =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.apply")),+ Core.applicationArgument = (Typed.unTypedTerm ef)})),+ Core.applicationArgument = (Typed.unTypedTerm ex)}))++-- | DSL reference to hydra.lib.effects.bind+bind :: Typed.TypedTerm (IO x) -> Typed.TypedTerm (x -> IO y) -> Typed.TypedTerm (IO y)+bind e f =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.bind")),+ Core.applicationArgument = (Typed.unTypedTerm e)})),+ Core.applicationArgument = (Typed.unTypedTerm f)}))++-- | DSL reference to hydra.lib.effects.compose+compose :: Typed.TypedTerm (x -> IO y) -> Typed.TypedTerm (y -> IO z) -> Typed.TypedTerm x -> Typed.TypedTerm (IO z)+compose f g x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.compose")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm g)})),+ Core.applicationArgument = (Typed.unTypedTerm x)}))++-- | DSL reference to hydra.lib.effects.foldList+foldList :: Typed.TypedTerm (x -> y -> IO x) -> Typed.TypedTerm x -> Typed.TypedTerm [y] -> Typed.TypedTerm (IO x)+foldList f acc0 xs =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.foldList")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm acc0)})),+ Core.applicationArgument = (Typed.unTypedTerm xs)}))++-- | DSL reference to hydra.lib.effects.map+map :: Typed.TypedTerm (x -> y) -> Typed.TypedTerm (IO x) -> Typed.TypedTerm (IO y)+map f e =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.map")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm e)}))++-- | DSL reference to hydra.lib.effects.mapList+mapList :: Typed.TypedTerm (x -> IO y) -> Typed.TypedTerm [x] -> Typed.TypedTerm (IO [y])+mapList f xs =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.mapList")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm xs)}))++-- | DSL reference to hydra.lib.effects.mapOptional+mapOptional :: Typed.TypedTerm (x -> IO y) -> Typed.TypedTerm (Maybe x) -> Typed.TypedTerm (IO (Maybe y))+mapOptional f m =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.mapOptional")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm m)}))++-- | DSL reference to hydra.lib.effects.mapSet+mapSet :: (Ord x, Ord y) => (Typed.TypedTerm (x -> IO y) -> Typed.TypedTerm (S.Set x) -> Typed.TypedTerm (IO (S.Set y)))+mapSet f s =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.mapSet")),+ Core.applicationArgument = (Typed.unTypedTerm f)})),+ Core.applicationArgument = (Typed.unTypedTerm s)}))++-- | DSL reference to hydra.lib.effects.pure+pure :: Typed.TypedTerm x -> Typed.TypedTerm (IO x)+pure x =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.effects.pure")),+ Core.applicationArgument = (Typed.unTypedTerm x)}))
+ src/main/haskell/Hydra/Dsl/Lib/Files.hs view
@@ -0,0 +1,157 @@+-- Note: this is an automatically generated file. Do not edit.++-- | DSL functions for hydra.lib.files++module Hydra.Dsl.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.Dsl.Ast as DslAst+import qualified Hydra.Dsl.Coders as DslCoders+import qualified Hydra.Dsl.Core as DslCore+import qualified Hydra.Dsl.Docs as DslDocs+import qualified Hydra.Dsl.Error.Checking as ErrorChecking+import qualified Hydra.Dsl.Error.Core as DslErrorCore+import qualified Hydra.Dsl.Error.File as DslErrorFile+import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging+import qualified Hydra.Dsl.Error.System as DslErrorSystem+import qualified Hydra.Dsl.Errors as DslErrors+import qualified Hydra.Dsl.File as DslFile+import qualified Hydra.Dsl.Graph as DslGraph+import qualified Hydra.Dsl.Json.Model as JsonModel+import qualified Hydra.Dsl.Packaging as DslPackaging+import qualified Hydra.Dsl.Parsing as DslParsing+import qualified Hydra.Dsl.Paths as DslPaths+import qualified Hydra.Dsl.Query as DslQuery+import qualified Hydra.Dsl.Regex as DslRegex+import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.System as DslSystem+import qualified Hydra.Dsl.Tabular as DslTabular+import qualified Hydra.Dsl.Testing as DslTesting+import qualified Hydra.Dsl.Time as DslTime+import qualified Hydra.Dsl.Topology as DslTopology+import qualified Hydra.Dsl.Typing as DslTyping+import qualified Hydra.Dsl.Util as DslUtil+import qualified Hydra.Dsl.Validation as DslValidation+import qualified Hydra.Dsl.Variants as DslVariants+import qualified Hydra.Error.Checking as Checking+import qualified Hydra.Error.Core as ErrorCore+import qualified Hydra.Error.File as ErrorFile+import qualified Hydra.Error.Packaging as ErrorPackaging+import qualified Hydra.Error.System as ErrorSystem+import qualified Hydra.Errors as Errors+import qualified Hydra.File as File+import qualified Hydra.Graph as Graph+import qualified Hydra.Json.Model as Model+import qualified Hydra.Packaging as Packaging+import qualified Hydra.Parsing as Parsing+import qualified Hydra.Paths as Paths+import qualified Hydra.Query as Query+import qualified Hydra.Regex as Regex+import qualified Hydra.Relational as Relational+import qualified Hydra.System as System+import qualified Hydra.Tabular as Tabular+import qualified Hydra.Testing as Testing+import qualified Hydra.Time as Time+import qualified Hydra.Topology as Topology+import qualified Hydra.Typed as Typed+import qualified Hydra.Typing as Typing+import qualified Hydra.Util as Util+import qualified Hydra.Validation as Validation+import qualified Hydra.Variants as Variants+import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)+import qualified Data.Scientific as Sci+import qualified Data.ByteString as B++-- | DSL reference to hydra.lib.files.appendFile+appendFile :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+appendFile path contents =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.appendFile")),+ Core.applicationArgument = (Typed.unTypedTerm path)})),+ Core.applicationArgument = (Typed.unTypedTerm contents)}))++-- | DSL reference to hydra.lib.files.copy+copy :: Typed.TypedTerm Bool -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+copy recursive source destination =+ 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.files.copy")),+ Core.applicationArgument = (Typed.unTypedTerm recursive)})),+ Core.applicationArgument = (Typed.unTypedTerm source)})),+ Core.applicationArgument = (Typed.unTypedTerm destination)}))++-- | DSL reference to hydra.lib.files.createDirectory+createDirectory :: Typed.TypedTerm Bool -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+createDirectory recursive path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.createDirectory")),+ Core.applicationArgument = (Typed.unTypedTerm recursive)})),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.exists+exists :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError Bool))+exists path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.exists")),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.listDirectory+listDirectory :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError [File.FilePath]))+listDirectory path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.listDirectory")),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.readFile+readFile :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError B.ByteString))+readFile path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.readFile")),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.removeDirectory+removeDirectory :: Typed.TypedTerm Bool -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+removeDirectory recursive path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.removeDirectory")),+ Core.applicationArgument = (Typed.unTypedTerm recursive)})),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.removeFile+removeFile :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+removeFile path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.removeFile")),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.rename+rename :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+rename source destination =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.rename")),+ Core.applicationArgument = (Typed.unTypedTerm source)})),+ Core.applicationArgument = (Typed.unTypedTerm destination)}))++-- | DSL reference to hydra.lib.files.status+status :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm (IO (Either ErrorFile.FileError File.FileStatus))+status path =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.status")),+ Core.applicationArgument = (Typed.unTypedTerm path)}))++-- | DSL reference to hydra.lib.files.writeFile+writeFile :: Typed.TypedTerm File.FilePath -> Typed.TypedTerm B.ByteString -> Typed.TypedTerm (IO (Either ErrorFile.FileError ()))+writeFile path contents =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.files.writeFile")),+ Core.applicationArgument = (Typed.unTypedTerm path)})),+ Core.applicationArgument = (Typed.unTypedTerm contents)}))
src/main/haskell/Hydra/Dsl/Lib/Math.hs view
@@ -65,11 +65,11 @@ import qualified Data.Scientific as Sci -- | DSL reference to hydra.lib.math.abs-abs :: Typed.TypedTerm Int -> Typed.TypedTerm Int-abs x =+abs :: Typed.TypedTerm x -> Typed.TypedTerm x+abs arg0 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.abs")),- Core.applicationArgument = (Typed.unTypedTerm x)}))+ Core.applicationArgument = (Typed.unTypedTerm arg0)})) -- | DSL reference to hydra.lib.math.acos acos :: Typed.TypedTerm Double -> Typed.TypedTerm Double@@ -162,7 +162,7 @@ Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.div-div :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int)+div :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) div x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application {@@ -170,12 +170,21 @@ Core.applicationArgument = (Typed.unTypedTerm x)})), Core.applicationArgument = (Typed.unTypedTerm y)})) +-- | DSL reference to hydra.lib.math.divide+divide :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm x+divide arg0 arg1 =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.divide")),+ Core.applicationArgument = (Typed.unTypedTerm arg0)})),+ Core.applicationArgument = (Typed.unTypedTerm arg1)}))+ -- | 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 :: Typed.TypedTerm x -> Typed.TypedTerm Bool even x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.even")),@@ -212,7 +221,7 @@ Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.mod-mod :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int)+mod :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) mod x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application {@@ -253,7 +262,7 @@ Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.odd-odd :: Typed.TypedTerm Int -> Typed.TypedTerm Bool+odd :: Typed.TypedTerm x -> Typed.TypedTerm Bool odd x = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.odd")),@@ -282,7 +291,7 @@ Core.applicationArgument = (Typed.unTypedTerm b)})) -- | DSL reference to hydra.lib.math.rem-rem :: Typed.TypedTerm Int -> Typed.TypedTerm Int -> Typed.TypedTerm (Maybe Int)+rem :: Typed.TypedTerm x -> Typed.TypedTerm x -> Typed.TypedTerm (Maybe x) rem x y = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermApplication (Core.Application {@@ -316,11 +325,11 @@ Core.applicationArgument = (Typed.unTypedTerm x)})) -- | DSL reference to hydra.lib.math.signum-signum :: Typed.TypedTerm Int -> Typed.TypedTerm Int-signum x =+signum :: Typed.TypedTerm x -> Typed.TypedTerm x+signum arg0 = Typed.TypedTerm (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.signum")),- Core.applicationArgument = (Typed.unTypedTerm x)}))+ Core.applicationArgument = (Typed.unTypedTerm arg0)})) -- | DSL reference to hydra.lib.math.sin sin :: Typed.TypedTerm Double -> Typed.TypedTerm Double
+ src/main/haskell/Hydra/Dsl/Lib/System.hs view
@@ -0,0 +1,118 @@+-- Note: this is an automatically generated file. Do not edit.++-- | DSL functions for hydra.lib.system++module Hydra.Dsl.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.Dsl.Ast as DslAst+import qualified Hydra.Dsl.Coders as DslCoders+import qualified Hydra.Dsl.Core as DslCore+import qualified Hydra.Dsl.Docs as DslDocs+import qualified Hydra.Dsl.Error.Checking as ErrorChecking+import qualified Hydra.Dsl.Error.Core as DslErrorCore+import qualified Hydra.Dsl.Error.File as DslErrorFile+import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging+import qualified Hydra.Dsl.Error.System as DslErrorSystem+import qualified Hydra.Dsl.Errors as DslErrors+import qualified Hydra.Dsl.File as DslFile+import qualified Hydra.Dsl.Graph as DslGraph+import qualified Hydra.Dsl.Json.Model as JsonModel+import qualified Hydra.Dsl.Packaging as DslPackaging+import qualified Hydra.Dsl.Parsing as DslParsing+import qualified Hydra.Dsl.Paths as DslPaths+import qualified Hydra.Dsl.Query as DslQuery+import qualified Hydra.Dsl.Regex as DslRegex+import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.System as DslSystem+import qualified Hydra.Dsl.Tabular as DslTabular+import qualified Hydra.Dsl.Testing as DslTesting+import qualified Hydra.Dsl.Time as DslTime+import qualified Hydra.Dsl.Topology as DslTopology+import qualified Hydra.Dsl.Typing as DslTyping+import qualified Hydra.Dsl.Util as DslUtil+import qualified Hydra.Dsl.Validation as DslValidation+import qualified Hydra.Dsl.Variants as DslVariants+import qualified Hydra.Error.Checking as Checking+import qualified Hydra.Error.Core as ErrorCore+import qualified Hydra.Error.File as ErrorFile+import qualified Hydra.Error.Packaging as ErrorPackaging+import qualified Hydra.Error.System as ErrorSystem+import qualified Hydra.Errors as Errors+import qualified Hydra.File as File+import qualified Hydra.Graph as Graph+import qualified Hydra.Json.Model as Model+import qualified Hydra.Packaging as Packaging+import qualified Hydra.Parsing as Parsing+import qualified Hydra.Paths as Paths+import qualified Hydra.Query as Query+import qualified Hydra.Regex as Regex+import qualified Hydra.Relational as Relational+import qualified Hydra.System as System+import qualified Hydra.Tabular as Tabular+import qualified Hydra.Testing as Testing+import qualified Hydra.Time as Time+import qualified Hydra.Topology as Topology+import qualified Hydra.Typed as Typed+import qualified Hydra.Typing as Typing+import qualified Hydra.Util as Util+import qualified Hydra.Validation as Validation+import qualified Hydra.Variants as Variants+import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)+import qualified Data.Scientific as Sci+import qualified Data.ByteString as B+import qualified Data.Map as M++-- | DSL reference to hydra.lib.system.execute+execute :: Typed.TypedTerm System.Command -> Typed.TypedTerm (IO (Either ErrorSystem.SystemError System.ProcessResult))+execute command =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.system.execute")),+ Core.applicationArgument = (Typed.unTypedTerm command)}))++-- | DSL reference to hydra.lib.system.exit+exit :: Typed.TypedTerm System.StatusCode -> Typed.TypedTerm (IO ())+exit code =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.system.exit")),+ Core.applicationArgument = (Typed.unTypedTerm code)}))++-- | DSL reference to hydra.lib.system.getEnvironment+getEnvironment :: Typed.TypedTerm (IO (M.Map System.EnvironmentVariable String))+getEnvironment = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.system.getEnvironment"))++-- | DSL reference to hydra.lib.system.getEnvironmentVariable+getEnvironmentVariable :: Typed.TypedTerm System.EnvironmentVariable -> Typed.TypedTerm (IO (Maybe String))+getEnvironmentVariable name =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.system.getEnvironmentVariable")),+ Core.applicationArgument = (Typed.unTypedTerm name)}))++-- | DSL reference to hydra.lib.system.getTime+getTime :: Typed.TypedTerm (IO Time.Timespec)+getTime = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.system.getTime"))++-- | DSL reference to hydra.lib.system.getWorkingDirectory+getWorkingDirectory :: Typed.TypedTerm (IO (Either ErrorSystem.SystemError File.FilePath))+getWorkingDirectory = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.system.getWorkingDirectory"))++-- | DSL reference to hydra.lib.system.readStdin+readStdin :: Typed.TypedTerm (IO (Either ErrorSystem.SystemError B.ByteString))+readStdin = Typed.TypedTerm (Core.TermVariable (Core.Name "hydra.lib.system.readStdin"))++-- | DSL reference to hydra.lib.system.writeStderr+writeStderr :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm (IO (Either ErrorSystem.SystemError ()))+writeStderr bytes =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.system.writeStderr")),+ Core.applicationArgument = (Typed.unTypedTerm bytes)}))++-- | DSL reference to hydra.lib.system.writeStdout+writeStdout :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm (IO (Either ErrorSystem.SystemError ()))+writeStdout bytes =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.system.writeStdout")),+ Core.applicationArgument = (Typed.unTypedTerm bytes)}))
+ src/main/haskell/Hydra/Dsl/Lib/Text.hs view
@@ -0,0 +1,80 @@+-- Note: this is an automatically generated file. Do not edit.++-- | DSL functions for hydra.lib.text++module Hydra.Dsl.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.Dsl.Ast as DslAst+import qualified Hydra.Dsl.Coders as DslCoders+import qualified Hydra.Dsl.Core as DslCore+import qualified Hydra.Dsl.Docs as DslDocs+import qualified Hydra.Dsl.Error.Checking as ErrorChecking+import qualified Hydra.Dsl.Error.Core as DslErrorCore+import qualified Hydra.Dsl.Error.File as DslErrorFile+import qualified Hydra.Dsl.Error.Packaging as DslErrorPackaging+import qualified Hydra.Dsl.Error.System as DslErrorSystem+import qualified Hydra.Dsl.Errors as DslErrors+import qualified Hydra.Dsl.File as DslFile+import qualified Hydra.Dsl.Graph as DslGraph+import qualified Hydra.Dsl.Json.Model as JsonModel+import qualified Hydra.Dsl.Packaging as DslPackaging+import qualified Hydra.Dsl.Parsing as DslParsing+import qualified Hydra.Dsl.Paths as DslPaths+import qualified Hydra.Dsl.Query as DslQuery+import qualified Hydra.Dsl.Regex as DslRegex+import qualified Hydra.Dsl.Relational as DslRelational+import qualified Hydra.Dsl.System as DslSystem+import qualified Hydra.Dsl.Tabular as DslTabular+import qualified Hydra.Dsl.Testing as DslTesting+import qualified Hydra.Dsl.Time as DslTime+import qualified Hydra.Dsl.Topology as DslTopology+import qualified Hydra.Dsl.Typing as DslTyping+import qualified Hydra.Dsl.Util as DslUtil+import qualified Hydra.Dsl.Validation as DslValidation+import qualified Hydra.Dsl.Variants as DslVariants+import qualified Hydra.Error.Checking as Checking+import qualified Hydra.Error.Core as ErrorCore+import qualified Hydra.Error.File as ErrorFile+import qualified Hydra.Error.Packaging as ErrorPackaging+import qualified Hydra.Error.System as ErrorSystem+import qualified Hydra.Errors as Errors+import qualified Hydra.File as File+import qualified Hydra.Graph as Graph+import qualified Hydra.Json.Model as Model+import qualified Hydra.Packaging as Packaging+import qualified Hydra.Parsing as Parsing+import qualified Hydra.Paths as Paths+import qualified Hydra.Query as Query+import qualified Hydra.Regex as Regex+import qualified Hydra.Relational as Relational+import qualified Hydra.System as System+import qualified Hydra.Tabular as Tabular+import qualified Hydra.Testing as Testing+import qualified Hydra.Time as Time+import qualified Hydra.Topology as Topology+import qualified Hydra.Typed as Typed+import qualified Hydra.Typing as Typing+import qualified Hydra.Util as Util+import qualified Hydra.Validation as Validation+import qualified Hydra.Variants as Variants+import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)+import qualified Data.Scientific as Sci+import qualified Data.ByteString as B++-- | DSL reference to hydra.lib.text.decodeUtf8+decodeUtf8 :: Typed.TypedTerm B.ByteString -> Typed.TypedTerm (Either String String)+decodeUtf8 bytes =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.text.decodeUtf8")),+ Core.applicationArgument = (Typed.unTypedTerm bytes)}))++-- | DSL reference to hydra.lib.text.encodeUtf8+encodeUtf8 :: Typed.TypedTerm String -> Typed.TypedTerm B.ByteString+encodeUtf8 text =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.text.encodeUtf8")),+ Core.applicationArgument = (Typed.unTypedTerm text)}))
src/main/haskell/Hydra/Dsl/Regex.hs view
@@ -6,6 +6,7 @@ import qualified Hydra.Core as Core import qualified Hydra.Decode.Regex as DecodeRegex+import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Encode.Regex as EncodeRegex import qualified Hydra.Regex as Regex import qualified Hydra.Typed as Typed
src/main/haskell/Hydra/Dsl/Resolution.hs view
@@ -164,6 +164,15 @@ Core.applicationArgument = (Typed.unTypedTerm arg0)})), Core.applicationArgument = (Typed.unTypedTerm arg1)})) +-- | DSL reference to hydra.resolution.mapKeyResolvesToString+mapKeyResolvesToString :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Bool+mapKeyResolvesToString arg0 arg1 =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.mapKeyResolvesToString")),+ Core.applicationArgument = (Typed.unTypedTerm arg0)})),+ Core.applicationArgument = (Typed.unTypedTerm arg1)}))+ -- | DSL reference to hydra.resolution.nominalApplication nominalApplication :: Typed.TypedTerm Core.Name -> Typed.TypedTerm [Core.Type] -> Typed.TypedTerm Core.Type nominalApplication arg0 arg1 =@@ -244,6 +253,15 @@ Core.applicationArgument = (Typed.unTypedTerm arg0)})), Core.applicationArgument = (Typed.unTypedTerm arg1)})), Core.applicationArgument = (Typed.unTypedTerm arg2)}))++-- | DSL reference to hydra.resolution.resolveBaseType+resolveBaseType :: Typed.TypedTerm (M.Map Core.Name Core.Type) -> Typed.TypedTerm Core.Type -> Typed.TypedTerm Core.Type+resolveBaseType arg0 arg1 =+ Typed.TypedTerm (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.resolution.resolveBaseType")),+ Core.applicationArgument = (Typed.unTypedTerm arg0)})),+ Core.applicationArgument = (Typed.unTypedTerm arg1)})) -- | DSL reference to hydra.resolution.resolveType resolveType :: Typed.TypedTerm Graph.Graph -> Typed.TypedTerm Core.Type -> Typed.TypedTerm (Maybe Core.Type)
src/main/haskell/Hydra/Encode/Error/Core.hs view
@@ -151,6 +151,22 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.emptyUnionTypeErrorLocation x))}]}) +-- | Encoder for hydra.error.core.ExtraRecordFieldsError+extraRecordFieldsError :: ErrorCore.ExtraRecordFieldsError -> Core.Term+extraRecordFieldsError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.ExtraRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.extraRecordFieldsErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.extraRecordFieldsErrorTypeName x))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.name xs)) (ErrorCore.extraRecordFieldsErrorFieldNames x))}]})+ -- | Encoder for hydra.error.core.InvalidForallParameterNameError invalidForallParameterNameError :: ErrorCore.InvalidForallParameterNameError -> Core.Term invalidForallParameterNameError x =@@ -239,6 +255,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "emptyTypeNameInTerm"), Core.fieldTerm = (emptyTypeNameInTermError v0)}})+ ErrorCore.InvalidTermErrorExtraRecordFields v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "extraRecordFields"),+ Core.fieldTerm = (extraRecordFieldsError v0)}}) ErrorCore.InvalidTermErrorInvalidLambdaParameterName v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field {@@ -259,11 +280,21 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "missingCaseBranches"), Core.fieldTerm = (missingCaseBranchesError v0)}})+ ErrorCore.InvalidTermErrorMissingRecordFields v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "missingRecordFields"),+ Core.fieldTerm = (missingRecordFieldsError v0)}}) ErrorCore.InvalidTermErrorNestedTermAnnotation v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "nestedTermAnnotation"), Core.fieldTerm = (nestedTermAnnotationError v0)}})+ ErrorCore.InvalidTermErrorNominalTypeKindMismatch v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "nominalTypeKindMismatch"),+ Core.fieldTerm = (nominalTypeKindMismatchError v0)}}) ErrorCore.InvalidTermErrorRedundantWrapUnwrap v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field {@@ -284,6 +315,11 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "typeVariableShadowingInTypeLambda"), Core.fieldTerm = (typeVariableShadowingInTypeLambdaError v0)}})+ ErrorCore.InvalidTermErrorUndeclaredVariant v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "undeclaredVariant"),+ Core.fieldTerm = (undeclaredVariantError v0)}}) ErrorCore.InvalidTermErrorUndefinedTermVariable v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field {@@ -314,11 +350,21 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unknownPrimitiveName"), Core.fieldTerm = (unknownPrimitiveNameError v0)}})+ ErrorCore.InvalidTermErrorUnknownProjectedField v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "unknownProjectedField"),+ Core.fieldTerm = (unknownProjectedFieldError v0)}}) ErrorCore.InvalidTermErrorUnnecessaryIdentityApplication v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "unnecessaryIdentityApplication"), Core.fieldTerm = (unnecessaryIdentityApplicationError v0)}})+ ErrorCore.InvalidTermErrorUnresolvedNominalType v0 -> Core.TermInject (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "unresolvedNominalType"),+ Core.fieldTerm = (unresolvedNominalTypeError v0)}}) ErrorCore.InvalidTermErrorUntypedTermVariable v0 -> Core.TermInject (Core.Injection { Core.injectionTypeName = (Core.Name "hydra.error.core.InvalidTermError"), Core.injectionField = Core.Field {@@ -455,6 +501,22 @@ Core.fieldName = (Core.Name "variantNames"), Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.name xs)) (ErrorCore.missingCaseBranchesErrorVariantNames x))}]}) +-- | Encoder for hydra.error.core.MissingRecordFieldsError+missingRecordFieldsError :: ErrorCore.MissingRecordFieldsError -> Core.Term+missingRecordFieldsError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.MissingRecordFieldsError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.missingRecordFieldsErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.missingRecordFieldsErrorTypeName x))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldNames"),+ Core.fieldTerm = ((\xs -> Core.TermList (Lists.map EncodeCore.name xs)) (ErrorCore.missingRecordFieldsErrorFieldNames x))}]})+ -- | Encoder for hydra.error.core.NestedTermAnnotationError nestedTermAnnotationError :: ErrorCore.NestedTermAnnotationError -> Core.Term nestedTermAnnotationError x =@@ -475,6 +537,25 @@ Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.nestedTypeAnnotationErrorLocation x))}]}) +-- | Encoder for hydra.error.core.NominalTypeKindMismatchError+nominalTypeKindMismatchError :: ErrorCore.NominalTypeKindMismatchError -> Core.Term+nominalTypeKindMismatchError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.NominalTypeKindMismatchError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.nominalTypeKindMismatchErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.nominalTypeKindMismatchErrorTypeName x))},+ Core.Field {+ Core.fieldName = (Core.Name "expectedVariant"),+ Core.fieldTerm = (Variants.typeVariant (ErrorCore.nominalTypeKindMismatchErrorExpectedVariant x))},+ Core.Field {+ Core.fieldName = (Core.Name "actualVariant"),+ Core.fieldTerm = (Variants.typeVariant (ErrorCore.nominalTypeKindMismatchErrorActualVariant x))}]})+ -- | Encoder for hydra.error.core.NonComparableMapKeyTypeError nonComparableMapKeyTypeError :: ErrorCore.NonComparableMapKeyTypeError -> Core.Term nonComparableMapKeyTypeError x =@@ -579,6 +660,22 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.typeVariableShadowingInTypeLambdaErrorName x))}]}) +-- | Encoder for hydra.error.core.UndeclaredVariantError+undeclaredVariantError :: ErrorCore.UndeclaredVariantError -> Core.Term+undeclaredVariantError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UndeclaredVariantError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.undeclaredVariantErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.undeclaredVariantErrorTypeName x))},+ Core.Field {+ Core.fieldName = (Core.Name "variantName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.undeclaredVariantErrorVariantName x))}]})+ -- | Encoder for hydra.error.core.UndefinedFieldError undefinedFieldError :: ErrorCore.UndefinedFieldError -> Core.Term undefinedFieldError x =@@ -712,6 +809,22 @@ Core.fieldName = (Core.Name "name"), Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownPrimitiveNameErrorName x))}]}) +-- | Encoder for hydra.error.core.UnknownProjectedFieldError+unknownProjectedFieldError :: ErrorCore.UnknownProjectedFieldError -> Core.Term+unknownProjectedFieldError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnknownProjectedFieldError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.unknownProjectedFieldErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownProjectedFieldErrorTypeName x))},+ Core.Field {+ Core.fieldName = (Core.Name "fieldName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.unknownProjectedFieldErrorFieldName x))}]})+ -- | Encoder for hydra.error.core.UnnecessaryIdentityApplicationError unnecessaryIdentityApplicationError :: ErrorCore.UnnecessaryIdentityApplicationError -> Core.Term unnecessaryIdentityApplicationError x =@@ -721,6 +834,19 @@ Core.Field { Core.fieldName = (Core.Name "location"), Core.fieldTerm = (Paths.subtermPath (ErrorCore.unnecessaryIdentityApplicationErrorLocation x))}]})++-- | Encoder for hydra.error.core.UnresolvedNominalTypeError+unresolvedNominalTypeError :: ErrorCore.UnresolvedNominalTypeError -> Core.Term+unresolvedNominalTypeError x =+ Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra.error.core.UnresolvedNominalTypeError"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "location"),+ Core.fieldTerm = (Paths.subtermPath (ErrorCore.unresolvedNominalTypeErrorLocation x))},+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (EncodeCore.name (ErrorCore.unresolvedNominalTypeErrorTypeName x))}]}) -- | Encoder for hydra.error.core.UntypedTermVariableError untypedTermVariableError :: ErrorCore.UntypedTermVariableError -> Core.Term
src/main/haskell/Hydra/Encode/Regex.hs view
@@ -5,6 +5,7 @@ module Hydra.Encode.Regex where import qualified Hydra.Core as Core+import qualified Hydra.Encode.Core as EncodeCore import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Regex as Regex import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
src/main/haskell/Hydra/Error/Core.hs view
@@ -166,6 +166,25 @@ _EmptyUnionTypeError_location = Core.Name "location" +-- | A record term supplying a field that its record type does not declare+data ExtraRecordFieldsError =+ ExtraRecordFieldsError {+ -- | The path to the record term within the term+ extraRecordFieldsErrorLocation :: Paths.SubtermPath,+ -- | The name of the record type+ extraRecordFieldsErrorTypeName :: Core.Name,+ -- | The names of the undeclared fields supplied by the record term+ extraRecordFieldsErrorFieldNames :: [Core.Name]}+ deriving (Eq, Ord, Read, Show)++_ExtraRecordFieldsError = Core.Name "hydra.error.core.ExtraRecordFieldsError"++_ExtraRecordFieldsError_location = Core.Name "location"++_ExtraRecordFieldsError_typeName = Core.Name "typeName"++_ExtraRecordFieldsError_fieldNames = Core.Name "fieldNames"+ -- | A forall type parameter name that violates type variable naming conventions (optional) data InvalidForallParameterNameError = InvalidForallParameterNameError {@@ -237,6 +256,8 @@ InvalidTermErrorEmptyTermAnnotation EmptyTermAnnotationError | -- | A term with an empty type name (optional) InvalidTermErrorEmptyTypeNameInTerm EmptyTypeNameInTermError |+ -- | A record term supplying a field not declared by its record type+ InvalidTermErrorExtraRecordFields ExtraRecordFieldsError | -- | A lambda parameter name violating naming conventions (optional) InvalidTermErrorInvalidLambdaParameterName InvalidLambdaParameterNameError | -- | A let binding name violating naming conventions (optional)@@ -245,8 +266,12 @@ InvalidTermErrorInvalidTypeLambdaParameterName InvalidTypeLambdaParameterNameError | -- | A case statement that does not cover every variant of the union it matches InvalidTermErrorMissingCaseBranches MissingCaseBranchesError |+ -- | A record term omitting a field declared by its record type+ InvalidTermErrorMissingRecordFields MissingRecordFieldsError | -- | Nested term annotations that should be merged (optional) InvalidTermErrorNestedTermAnnotation NestedTermAnnotationError |+ -- | A nominal type reference resolving to a type of the wrong kind (e.g. a record term naming a union type)+ InvalidTermErrorNominalTypeKindMismatch NominalTypeKindMismatchError | -- | A no-op unwrap-of-wrap round-trip (optional) InvalidTermErrorRedundantWrapUnwrap RedundantWrapUnwrapError | -- | A variable applied to itself (optional)@@ -255,6 +280,8 @@ InvalidTermErrorTermVariableShadowing TermVariableShadowingError | -- | A type lambda parameter that shadows a type variable in scope (optional) InvalidTermErrorTypeVariableShadowingInTypeLambda TypeVariableShadowingInTypeLambdaError |+ -- | An injection naming a variant that is not declared by its union type+ InvalidTermErrorUndeclaredVariant UndeclaredVariantError | -- | A variable reference to an unbound term name InvalidTermErrorUndefinedTermVariable UndefinedTermVariableError | -- | An unbound type variable in a let binding's type scheme@@ -267,8 +294,12 @@ InvalidTermErrorUnknownCaseAlternative UnknownCaseAlternativeError | -- | A reference to an unknown primitive function InvalidTermErrorUnknownPrimitiveName UnknownPrimitiveNameError |+ -- | A projection naming a field that is not declared by its record type+ InvalidTermErrorUnknownProjectedField UnknownProjectedFieldError | -- | An identity lambda applied to an argument (optional) InvalidTermErrorUnnecessaryIdentityApplication UnnecessaryIdentityApplicationError |+ -- | A nominal type reference that does not resolve to any declared type in scope+ InvalidTermErrorUnresolvedNominalType UnresolvedNominalTypeError | -- | A term variable whose type is not known InvalidTermErrorUntypedTermVariable UntypedTermVariableError deriving (Eq, Ord, Read, Show)@@ -289,6 +320,8 @@ _InvalidTermError_emptyTypeNameInTerm = Core.Name "emptyTypeNameInTerm" +_InvalidTermError_extraRecordFields = Core.Name "extraRecordFields"+ _InvalidTermError_invalidLambdaParameterName = Core.Name "invalidLambdaParameterName" _InvalidTermError_invalidLetBindingName = Core.Name "invalidLetBindingName"@@ -297,8 +330,12 @@ _InvalidTermError_missingCaseBranches = Core.Name "missingCaseBranches" +_InvalidTermError_missingRecordFields = Core.Name "missingRecordFields"+ _InvalidTermError_nestedTermAnnotation = Core.Name "nestedTermAnnotation" +_InvalidTermError_nominalTypeKindMismatch = Core.Name "nominalTypeKindMismatch"+ _InvalidTermError_redundantWrapUnwrap = Core.Name "redundantWrapUnwrap" _InvalidTermError_selfApplication = Core.Name "selfApplication"@@ -307,6 +344,8 @@ _InvalidTermError_typeVariableShadowingInTypeLambda = Core.Name "typeVariableShadowingInTypeLambda" +_InvalidTermError_undeclaredVariant = Core.Name "undeclaredVariant"+ _InvalidTermError_undefinedTermVariable = Core.Name "undefinedTermVariable" _InvalidTermError_undefinedTypeVariableInBindingType = Core.Name "undefinedTypeVariableInBindingType"@@ -319,8 +358,12 @@ _InvalidTermError_unknownPrimitiveName = Core.Name "unknownPrimitiveName" +_InvalidTermError_unknownProjectedField = Core.Name "unknownProjectedField"+ _InvalidTermError_unnecessaryIdentityApplication = Core.Name "unnecessaryIdentityApplication" +_InvalidTermError_unresolvedNominalType = Core.Name "unresolvedNominalType"+ _InvalidTermError_untypedTermVariable = Core.Name "untypedTermVariable" -- | An error indicating that a type is invalid@@ -449,6 +492,25 @@ _MissingCaseBranchesError_variantNames = Core.Name "variantNames" +-- | A record term omitting a field declared by its record type+data MissingRecordFieldsError =+ MissingRecordFieldsError {+ -- | The path to the record term within the term+ missingRecordFieldsErrorLocation :: Paths.SubtermPath,+ -- | The name of the record type+ missingRecordFieldsErrorTypeName :: Core.Name,+ -- | The names of the missing fields+ missingRecordFieldsErrorFieldNames :: [Core.Name]}+ deriving (Eq, Ord, Read, Show)++_MissingRecordFieldsError = Core.Name "hydra.error.core.MissingRecordFieldsError"++_MissingRecordFieldsError_location = Core.Name "location"++_MissingRecordFieldsError_typeName = Core.Name "typeName"++_MissingRecordFieldsError_fieldNames = Core.Name "fieldNames"+ -- | A term annotation directly wrapping another term annotation; annotations should be merged (optional) data NestedTermAnnotationError = NestedTermAnnotationError {@@ -471,6 +533,29 @@ _NestedTypeAnnotationError_location = Core.Name "location" +-- | A nominal type reference in a term (inject, cases, record, project, wrap, or unwrap) resolving to a declared type of the wrong kind, e.g. a record term naming a union type+data NominalTypeKindMismatchError =+ NominalTypeKindMismatchError {+ -- | The path to the term with the mismatched nominal type reference+ nominalTypeKindMismatchErrorLocation :: Paths.SubtermPath,+ -- | The name of the referenced type+ nominalTypeKindMismatchErrorTypeName :: Core.Name,+ -- | The type variant required at this site+ nominalTypeKindMismatchErrorExpectedVariant :: Variants.TypeVariant,+ -- | The type variant that the name actually resolves to+ nominalTypeKindMismatchErrorActualVariant :: Variants.TypeVariant}+ deriving (Eq, Ord, Read, Show)++_NominalTypeKindMismatchError = Core.Name "hydra.error.core.NominalTypeKindMismatchError"++_NominalTypeKindMismatchError_location = Core.Name "location"++_NominalTypeKindMismatchError_typeName = Core.Name "typeName"++_NominalTypeKindMismatchError_expectedVariant = Core.Name "expectedVariant"++_NominalTypeKindMismatchError_actualVariant = Core.Name "actualVariant"+ -- | A map type whose key type is or directly contains a function type, which cannot be compared for equality data NonComparableMapKeyTypeError = NonComparableMapKeyTypeError {@@ -591,6 +676,25 @@ _TypeVariableShadowingInTypeLambdaError_name = Core.Name "name" +-- | An injection naming a variant that is not declared by its union type+data UndeclaredVariantError =+ UndeclaredVariantError {+ -- | The path to the injection within the term+ undeclaredVariantErrorLocation :: Paths.SubtermPath,+ -- | The name of the union type+ undeclaredVariantErrorTypeName :: Core.Name,+ -- | The undeclared variant name+ undeclaredVariantErrorVariantName :: Core.Name}+ deriving (Eq, Ord, Read, Show)++_UndeclaredVariantError = Core.Name "hydra.error.core.UndeclaredVariantError"++_UndeclaredVariantError_location = Core.Name "location"++_UndeclaredVariantError_typeName = Core.Name "typeName"++_UndeclaredVariantError_variantName = Core.Name "variantName"+ -- | A reference to a field that does not exist in the given type data UndefinedFieldError = UndefinedFieldError {@@ -745,6 +849,25 @@ _UnknownPrimitiveNameError_name = Core.Name "name" +-- | A projection naming a field that is not declared by its record type+data UnknownProjectedFieldError =+ UnknownProjectedFieldError {+ -- | The path to the projection within the term+ unknownProjectedFieldErrorLocation :: Paths.SubtermPath,+ -- | The name of the record type+ unknownProjectedFieldErrorTypeName :: Core.Name,+ -- | The unknown projected field name+ unknownProjectedFieldErrorFieldName :: Core.Name}+ deriving (Eq, Ord, Read, Show)++_UnknownProjectedFieldError = Core.Name "hydra.error.core.UnknownProjectedFieldError"++_UnknownProjectedFieldError_location = Core.Name "location"++_UnknownProjectedFieldError_typeName = Core.Name "typeName"++_UnknownProjectedFieldError_fieldName = Core.Name "fieldName"+ -- | An application of an identity lambda to an argument, which simplifies to the argument (optional) data UnnecessaryIdentityApplicationError = UnnecessaryIdentityApplicationError {@@ -755,6 +878,21 @@ _UnnecessaryIdentityApplicationError = Core.Name "hydra.error.core.UnnecessaryIdentityApplicationError" _UnnecessaryIdentityApplicationError_location = Core.Name "location"++-- | A nominal type reference in a term (inject, cases, record, project, wrap, or unwrap) that does not resolve to any declared type in scope+data UnresolvedNominalTypeError =+ UnresolvedNominalTypeError {+ -- | The path to the term with the unresolved nominal type reference+ unresolvedNominalTypeErrorLocation :: Paths.SubtermPath,+ -- | The unresolved type name+ unresolvedNominalTypeErrorTypeName :: Core.Name}+ deriving (Eq, Ord, Read, Show)++_UnresolvedNominalTypeError = Core.Name "hydra.error.core.UnresolvedNominalTypeError"++_UnresolvedNominalTypeError_location = Core.Name "location"++_UnresolvedNominalTypeError_typeName = Core.Name "typeName" -- | A term variable whose type is not known in the current scope data UntypedTermVariableError =
src/main/haskell/Hydra/Json/Decode.hs view
@@ -25,6 +25,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals+import qualified Hydra.Overlay.Haskell.Lib.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@@ -35,6 +36,7 @@ import qualified Hydra.Query as Query import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational+import qualified Hydra.Resolution as Resolution import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System@@ -164,9 +166,9 @@ 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 =+-- | Decode a JSON value to a Hydra term given a type and type name. Returns Left for type mismatches. The compactMaps flag mirrors toJson's: it must be False for any caller reading the checked-in dist/json module-bootstrapping representation, since a byte-stable published-host decoder must be able to read that data unmodified.+fromJson :: M.Map Core.Name Core.Type -> Bool -> Core.Name -> Core.Type -> Model.Value -> Either String Core.Term+fromJson types compactMaps tname typ value = let stripped = Strip.deannotateType typ reduceApp =@@ -189,17 +191,17 @@ "cannot apply a non-parametric type: ", (PrintCore.type_ fn)]) in case stripped of- Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> fromJson types tname reducedType value) (reduceApp v0)- Core.TypeForall v0 -> fromJson types tname (Core.forallTypeBody v0) value+ Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> fromJson types compactMaps tname reducedType value) (reduceApp v0)+ Core.TypeForall v0 -> fromJson types compactMaps tname (Core.forallTypeBody v0) value Core.TypeLiteral v0 -> decodeLiteral v0 value Core.TypeList v0 ->- let decodeElem = \v -> fromJson types tname v0 v+ let decodeElem = \v -> fromJson types compactMaps tname v0 v arrResult = expectArray value in (Eithers.either (\err -> Left err) (\arr -> let decoded = Eithers.mapList decodeElem arr in (Eithers.map (\ts -> Core.TermList ts) decoded)) arrResult) Core.TypeSet v0 ->- let decodeElem = \v -> fromJson types tname v0 v+ let decodeElem = \v -> fromJson types compactMaps tname v0 v arrResult = expectArray value in (Eithers.either (\err -> Left err) (\arr -> let decoded = Eithers.mapList decodeElem arr@@ -212,7 +214,7 @@ _ -> False in (Logic.ifElse isNestedMaybe ( let decodeJust =- \arr -> Optionals.cases (Lists.head arr) (Left "expected single-element array for Just") (\firstVal -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types tname v0 firstVal))+ \arr -> Optionals.cases (Lists.head arr) (Left "expected single-element array for Just") (\firstVal -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types compactMaps tname v0 firstVal)) decodeMaybeArray = \arr -> let len = Lists.length arr@@ -222,7 +224,7 @@ Model.ValueArray v1 -> decodeMaybeArray v1 _ -> Left "expected null or single-element array for nested Maybe") (case value of Model.ValueNull -> Right (Core.TermOptional Nothing)- _ -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types tname v0 value)))+ _ -> Eithers.map (\v -> Core.TermOptional (Just v)) (fromJson types compactMaps tname v0 value))) Core.TypeRecord v0 -> let objResult = expectObject value in (Eithers.either (\err -> Left err) (\obj ->@@ -233,7 +235,7 @@ mval = Maps.lookup (Core.unName fname) obj defaultVal = Model.ValueNull jsonVal = Optionals.withDefault defaultVal mval- decoded = fromJson types tname ftype jsonVal+ decoded = fromJson types compactMaps tname ftype jsonVal in (Eithers.map (\v -> Core.Field { Core.fieldName = fname, Core.fieldTerm = v}) decoded)@@ -245,7 +247,7 @@ let decodeVariant = \key -> \val -> \ftype -> let jsonVal = Optionals.withDefault Model.ValueNull val- decoded = fromJson types tname ftype jsonVal+ decoded = fromJson types compactMaps tname ftype jsonVal in (Eithers.map (\v -> Core.TermInject (Core.Injection { Core.injectionTypeName = tname, Core.injectionField = Core.Field {@@ -283,27 +285,45 @@ let objResult = expectObject value in (Eithers.map (\_2 -> Core.TermUnit) objResult) Core.TypeWrap v0 ->- let decoded = fromJson types tname v0 value+ let decoded = fromJson types compactMaps tname v0 value in (Eithers.map (\v -> Core.TermWrap (Core.WrappedTerm { Core.wrappedTermTypeName = tname, Core.wrappedTermBody = v})) decoded) Core.TypeMap v0 -> let keyType = Core.mapTypeKeys v0 valType = Core.mapTypeValues v0- arrResult = expectArray value- in (Eithers.either (\err -> Left err) (\arr ->- let decodeEntry =- \entryJson ->- let objResult = expectObject entryJson- in (Eithers.either (\err -> Left err) (\entryObj ->- let keyJson = Maps.lookup "key" entryObj- valJson = Maps.lookup "value" entryObj- in (Optionals.cases keyJson (Left "missing key in map entry") (\kj -> Optionals.cases valJson (Left "missing value in map entry") (\vj ->- let decodedKey = fromJson types tname keyType kj- decodedVal = fromJson types tname valType vj- in (Eithers.either (\err -> Left err) (\k -> Eithers.map (\v -> (k, v)) decodedVal) decodedKey))))) objResult)- entries = Eithers.mapList decodeEntry arr- in (Eithers.map (\es -> Core.TermMap (Maps.fromList es)) entries)) arrResult)+ compact = Logic.and compactMaps (Resolution.mapKeyResolvesToString types keyType)+ decodeArrayEntry =+ \entryJson ->+ let objResult = expectObject entryJson+ in (Eithers.either (\err -> Left err) (\entryObj ->+ let keyJson = Maps.lookup "key" entryObj+ valJson = Maps.lookup "value" entryObj+ in (Optionals.cases keyJson (Left "missing key in map entry") (\kj -> Optionals.cases valJson (Left "missing value in map entry") (\vj ->+ let decodedKey = fromJson types compactMaps tname keyType kj+ decodedVal = fromJson types compactMaps tname valType vj+ in (Eithers.either (\err -> Left err) (\k -> Eithers.map (\v -> (k, v)) decodedVal) decodedKey))))) objResult)+ decodeArrayForm =+ \arr ->+ let entries = Eithers.mapList decodeArrayEntry arr+ in (Eithers.map (\es -> Core.TermMap (Maps.fromList es)) entries)+ decodeCompactForm =+ \obj ->+ let rawKeys = Lists.map Pairs.first obj+ in (Logic.ifElse (Equality.equal (Lists.length rawKeys) (Lists.length (Lists.distinct rawKeys))) (+ let decodeCompactEntry =+ \kv ->+ let kStr = Pairs.first kv+ vJson = Pairs.second kv+ decodedKey = fromJson types compactMaps tname keyType (Model.ValueString kStr)+ decodedVal = fromJson types compactMaps tname valType vJson+ in (Eithers.either (\err -> Left err) (\k -> Eithers.map (\v -> (k, v)) decodedVal) decodedKey)+ entries = Eithers.mapList decodeCompactEntry obj+ in (Eithers.map (\es -> Core.TermMap (Maps.fromList es)) entries)) (Left "duplicate key in compact map object"))+ in case value of+ Model.ValueArray v1 -> decodeArrayForm v1+ Model.ValueObject v1 -> Logic.ifElse compact (decodeCompactForm v1) (Left "expected array for map with non-string-resolving key type")+ _ -> Left "expected object or array for map" Core.TypePair v0 -> let firstType = Core.pairTypeFirst v0 secondType = Core.pairTypeSecond v0@@ -312,8 +332,8 @@ let firstJson = Maps.lookup "first" obj secondJson = Maps.lookup "second" obj in (Optionals.cases firstJson (Left "missing first in pair") (\fj -> Optionals.cases secondJson (Left "missing second in pair") (\sj ->- let decodedFirst = fromJson types tname firstType fj- decodedSecond = fromJson types tname secondType sj+ let decodedFirst = fromJson types compactMaps tname firstType fj+ decodedSecond = fromJson types compactMaps tname secondType sj in (Eithers.either (\err -> Left err) (\f -> Eithers.map (\s -> Core.TermPair (f, s)) decodedSecond) decodedFirst))))) objResult) Core.TypeEither v0 -> let leftType = Core.eitherTypeLeft v0@@ -323,15 +343,15 @@ let leftJson = Maps.lookup "left" obj rightJson = Maps.lookup "right" obj in (Optionals.cases leftJson (Optionals.cases rightJson (Left "expected left or right in Either") (\rj ->- let decoded = fromJson types tname rightType rj+ let decoded = fromJson types compactMaps tname rightType rj in (Eithers.map (\v -> Core.TermEither (Right v)) decoded))) (\lj ->- let decoded = fromJson types tname leftType lj+ let decoded = fromJson types compactMaps tname leftType lj in (Eithers.map (\v -> Core.TermEither (Left v)) decoded)))) objResult) Core.TypeVariable v0 -> let lookedUp = Maps.lookup v0 types in (Optionals.cases lookedUp (Left (Strings.concat [ "unknown type variable: ",- (Core.unName v0)])) (\resolvedType -> fromJson types v0 resolvedType value))+ (Core.unName v0)])) (\resolvedType -> fromJson types compactMaps v0 resolvedType value)) _ -> Left (Strings.concat [ "unsupported type for JSON decoding: ", (PrintCore.type_ typ)])
src/main/haskell/Hydra/Json/Encode.hs view
@@ -36,6 +36,7 @@ import qualified Hydra.Query as Query import qualified Hydra.Regex as Regex import qualified Hydra.Relational as Relational+import qualified Hydra.Resolution as Resolution import qualified Hydra.Strip as Strip import qualified Hydra.Substitution as Substitution import qualified Hydra.System as System@@ -93,9 +94,9 @@ 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 =+-- | Encode a Hydra term to a JSON value given a type and type name. Returns Left for unsupported constructs. The compactMaps flag enables the #624 compact object form for string-resolving map keys; it must be False for any caller that reads/writes the checked-in dist/json module-bootstrapping representation (moduleToJson, decodeModuleFromJson, verify-json-kernel), since that wire format is consumed by the published (pre-#624) host and must stay byte-stable. New callers encoding/decoding arbitrary values against a schema (e.g. hydra.build.format digests) may pass True.+toJson :: M.Map Core.Name Core.Type -> Bool -> Core.Name -> Core.Type -> Core.Term -> Either String Model.Value+toJson types compactMaps tname typ term = let stripped = Strip.deannotateType typ strippedTerm = Strip.deannotateTerm term@@ -119,20 +120,20 @@ "cannot apply a non-parametric type: ", (PrintCore.type_ fn)]) in case stripped of- Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> toJson types tname reducedType term) (reduceApp v0)- Core.TypeForall v0 -> toJson types tname (Core.forallTypeBody v0) term+ Core.TypeApplication v0 -> Eithers.either (\err -> Left err) (\reducedType -> toJson types compactMaps tname reducedType term) (reduceApp v0)+ Core.TypeForall v0 -> toJson types compactMaps tname (Core.forallTypeBody v0) term Core.TypeLiteral _ -> case strippedTerm of Core.TermLiteral v1 -> encodeLiteral v1 _ -> Left "expected literal term" Core.TypeList v0 -> case strippedTerm of Core.TermList v1 ->- let results = Eithers.mapList (\t -> toJson types tname v0 t) v1+ let results = Eithers.mapList (\t -> toJson types compactMaps tname v0 t) v1 in (Eithers.map (\vs -> Model.ValueArray vs) results) _ -> Left "expected list term" Core.TypeSet v0 -> case strippedTerm of Core.TermSet v1 -> let terms = Sets.toList v1- results = Eithers.mapList (\t -> toJson types tname v0 t) terms+ results = Eithers.mapList (\t -> toJson types compactMaps tname v0 t) terms in (Eithers.map (\vs -> Model.ValueArray vs) results) _ -> Left "expected set term" Core.TypeOptional v0 ->@@ -143,7 +144,7 @@ _ -> False in case strippedTerm of Core.TermOptional v1 -> Optionals.cases v1 (Right Model.ValueNull) (\v ->- let encoded = toJson types tname v0 v+ let encoded = toJson types compactMaps tname v0 v in (Logic.ifElse isNestedMaybe (Eithers.map (\ev -> Model.ValueArray [ ev]) encoded) encoded)) _ -> Left "expected maybe term"@@ -166,10 +167,10 @@ case (Strip.deannotateType ftype) of Core.TypeOptional v3 -> v3 _ -> ftype- encoded = toJson types tname innerType v+ encoded = toJson types compactMaps tname innerType v in (Eithers.map (\ev -> Just (fname, ev)) encoded)) _ -> Left "expected maybe term for optional field") (- let encoded = toJson types tname ftype fterm+ let encoded = toJson types compactMaps tname ftype fterm in (Eithers.map (\ev -> Just (fname, ev)) encoded))) fieldTypes = v0 fields = Core.recordFields v1@@ -193,30 +194,45 @@ Core.TypeUnit -> True _ -> False in (Logic.ifElse isUnit (Right (Model.ValueString fname)) (- let encodedUnion = toJson types tname ftype fterm+ let encodedUnion = toJson types compactMaps 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- Core.TermWrap v1 -> toJson types tname v0 (Core.wrappedTermBody v1)+ Core.TermWrap v1 -> toJson types compactMaps tname v0 (Core.wrappedTermBody v1) _ -> Left "expected wrapped term" Core.TypeMap v0 -> let keyType = Core.mapTypeKeys v0 valType = Core.mapTypeValues v0+ compact = Logic.and compactMaps (Resolution.mapKeyResolvesToString types keyType) in case strippedTerm of- Core.TermMap v1 ->+ Core.TermMap v1 -> Logic.ifElse compact (+ let encodeCompactEntry =+ \kv ->+ let k = Pairs.first kv+ v = Pairs.second kv+ encodedK = toJson types compactMaps tname keyType k+ encodedV = toJson types compactMaps tname valType v+ in (Eithers.either (\err -> Left err) (\ek ->+ let keyStrResult =+ case ek of+ Model.ValueString v2 -> Right v2+ _ -> Left "internal error: string-resolving map key did not encode to a JSON string"+ in (Eithers.either (\err -> Left err) (\ks -> Eithers.map (\ev -> (ks, ev)) encodedV) keyStrResult)) encodedK)+ entries = Eithers.mapList encodeCompactEntry (Maps.toList v1)+ in (Eithers.map (\es -> Model.ValueObject es) entries)) ( let encodeEntry = \kv -> let k = Pairs.first kv v = Pairs.second kv- encodedK = toJson types tname keyType k- encodedV = toJson types tname valType v+ encodedK = toJson types compactMaps tname keyType k+ encodedV = toJson types compactMaps tname valType v in (Eithers.either (\err -> Left err) (\ek -> Eithers.map (\ev -> Model.ValueObject [ ("key", ek), ("value", ev)]) encodedV) encodedK) entries = Eithers.mapList encodeEntry (Maps.toList v1)- in (Eithers.map (\es -> Model.ValueArray es) entries)+ in (Eithers.map (\es -> Model.ValueArray es) entries)) _ -> Left "expected map term" Core.TypePair v0 -> let firstType = Core.pairTypeFirst v0@@ -225,8 +241,8 @@ Core.TermPair v1 -> let first = Pairs.first v1 second = Pairs.second v1- encodedFirst = toJson types tname firstType first- encodedSecond = toJson types tname secondType second+ encodedFirst = toJson types compactMaps tname firstType first+ encodedSecond = toJson types compactMaps tname secondType second in (Eithers.either (\err -> Left err) (\ef -> Eithers.map (\es -> Model.ValueObject [ ("first", ef), ("second", es)]) encodedSecond) encodedFirst)@@ -236,16 +252,16 @@ rightType = Core.eitherTypeRight v0 in case strippedTerm of Core.TermEither v1 -> Eithers.either (\l ->- let encodedL = toJson types tname leftType l+ let encodedL = toJson types compactMaps tname leftType l in (Eithers.map (\v -> Model.ValueObject [ ("left", v)]) encodedL)) (\r ->- let encodedR = toJson types tname rightType r+ let encodedR = toJson types compactMaps tname rightType r in (Eithers.map (\v -> Model.ValueObject [ ("right", v)]) encodedR)) v1 _ -> Left "expected either term" Core.TypeVariable v0 -> let lookedUp = Maps.lookup v0 types- in (Optionals.cases lookedUp (toJsonUntyped term) (\resolvedType -> toJson types v0 resolvedType term))+ in (Optionals.cases lookedUp (toJsonUntyped term) (\resolvedType -> toJson types compactMaps v0 resolvedType term)) _ -> Left (Strings.concat [ "unsupported type for JSON encoding: ", (PrintCore.type_ typ)])
src/main/haskell/Hydra/Json/Yaml/Decode.hs view
@@ -48,7 +48,7 @@ fromYaml types tname typ node = let jsonResult = yamlToJson node- in (Eithers.either (\err -> Left err) (\json -> Decode.fromJson types tname typ json) jsonResult)+ in (Eithers.either (\err -> Left err) (\json -> Decode.fromJson types False 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
src/main/haskell/Hydra/Json/Yaml/Encode.hs view
@@ -56,4 +56,4 @@ -- | 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)+toYaml types tname typ term = Eithers.map (\v -> jsonToYaml v) (Encode.toJson types False tname typ term)
src/main/haskell/Hydra/Lib/Defaults.hs view
@@ -918,24 +918,6 @@ Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.maps.toList")), Core.applicationArgument = (Core.TermVariable (Core.Name "m"))}))}))}))}))}))), (- Core.Name "hydra.lib.math.even",- (Core.TermLambda (Core.Lambda {- Core.lambdaParameter = (Core.Name "x"),- Core.lambdaDomain = Nothing,- Core.lambdaBody = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.equality.equal")),- Core.applicationArgument = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.optionals.withDefault")),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),- Core.applicationArgument = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mod")),- Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))}))}))})),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))),- ( Core.Name "hydra.lib.math.odd", (Core.TermLambda (Core.Lambda { Core.lambdaParameter = (Core.Name "x"),
src/main/haskell/Hydra/Lib/Math.hs view
@@ -41,24 +41,28 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.abs"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "The absolute value of an integer."),+ Packaging.entityMetadataDescription = (Just "Numeric absolute value."), Packaging.entityMetadataComments = [- "Absolute value of a signed 32-bit two's-complement integer. For non-negative inputs the result equals the input; for negative inputs the result is the arithmetic negation.",- "The function is total but not injective at the boundary: abs(minBound) = minBound (i.e. abs(-2147483648) = -2147483648), because +2147483648 is not representable in int32.",- "Corresponds to Haskell's abs :: Int32 -> Int32."],+ "Constraint-polymorphic absolute value over any type with a 'numeric' instance. The per-type semantics live in the instance: for fixed-width signed integers the result is total but not injective at the boundary (abs(minBound) = minBound, e.g. abs(-2147483648) = -2147483648 for int32, because +2147483648 is not representable); for unsigned integers and bigint the result is the input itself or its arithmetic negation, whichever is non-negative; for floating-point it clears the sign bit per IEEE 754 \2677.5.1 (abs(\2832) = +0, abs(NaN) is NaN).",+ "Requires a 'numeric' type-class constraint on the argument type.",+ "Corresponds to Haskell's abs :: Num a => a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter {- Typing.parameterName = (Core.Name "x"),- Typing.parameterDescription = (Just "the integer whose absolute value is taken"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ 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.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}},+ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing}@@ -406,34 +410,76 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.div"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Integer division, or Nothing if dividing by zero."),+ Packaging.entityMetadataDescription = (Just "Integral division, or Nothing if dividing by zero."), Packaging.entityMetadataComments = [- "Total integer division: div(x, y) returns Just(x divided by y, rounded toward negative infinity) when y is non-zero, and Nothing when y = 0.",+ "Constraint-polymorphic total integer division over any type with an 'integral' instance: div(x, y) returns Just(x divided by y, rounded toward negative infinity) when y is non-zero, and Nothing when y = 0.", "The division rounds toward negative infinity (floor), so for example div(-7, 2) = Just(-4).",- "The boundary case div(minBound, -1), whose mathematical result +2147483648 is not representable in int32, wraps to minBound (the two's-complement overflow).",- "Corresponds to Haskell's div :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."],+ "For fixed-width signed integers, the boundary case div(minBound, -1) wraps to minBound (the two's-complement overflow), since the mathematical result is not representable at that width.",+ "Requires an 'integral' type-class constraint on the argument type.",+ "Corresponds to Haskell's div :: Integral a => a -> a -> a, wrapped in maybe to make the zero-divisor case total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "integral")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "x"), Typing.parameterDescription = (Just "the dividend"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "y"), Typing.parameterDescription = (Just "the divisor"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing,- Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}},+ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing} +divide :: Packaging.PrimitiveDefinition+divide =+ Packaging.PrimitiveDefinition {+ Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.divide"),+ Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {+ Packaging.entityMetadataDescription = (Just "Floating-point division."),+ Packaging.entityMetadataComments = [+ "Constraint-polymorphic division over any type with a 'fractional' instance (float32, float64). IEEE 754 division: the result is x / y correctly rounded (roundTiesToEven) for finite y \8800 0.",+ "The operation is total via IEEE sentinels rather than an optional codomain: for finite nonzero x, x / \2832 = \177\8734 (sign = XOR of the operand signs); \2832 / \2832 and \177\8734 / \177\8734 are NaN; \177\8734 / finite = \177\8734 (sign XOR); finite / \177\8734 = \2832 (sign XOR); NaN propagates unconditionally.",+ "Requires a 'fractional' type-class constraint on the argument type.",+ "Corresponds to Haskell's (/) :: Fractional a => a -> a -> a."],+ Packaging.entityMetadataSeeAlso = [],+ Packaging.entityMetadataLifecycle = Nothing})),+ Packaging.primitiveDefinitionSignature = Typing.TermSignature {+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "fractional")]}],+ Typing.termSignatureParameters = [+ Typing.Parameter {+ Typing.parameterName = (Core.Name "arg0"),+ Typing.parameterDescription = Nothing,+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")),+ Typing.parameterIsLazy = False},+ Typing.Parameter {+ Typing.parameterName = (Core.Name "arg1"),+ Typing.parameterDescription = Nothing,+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")),+ Typing.parameterIsLazy = False}],+ Typing.termSignatureResult = Typing.Result {+ Typing.resultDescription = Nothing,+ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}},+ Packaging.primitiveDefinitionIsPure = True,+ Packaging.primitiveDefinitionIsTotal = True,+ Packaging.primitiveDefinitionDefaultImplementation = Nothing}+ e :: Packaging.PrimitiveDefinition e = Packaging.PrimitiveDefinition {@@ -460,41 +506,32 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.even"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Test whether an integer is even."),+ Packaging.entityMetadataDescription = (Just "Test whether a value is even."), Packaging.entityMetadataComments = [- "True if the argument is divisible by 2 (i.e. x mod 2 = 0), false otherwise.",- "Total on all int32 inputs including negative numbers and minBound. Corresponds to Haskell's even :: Int32 -> Bool."],+ "Constraint-polymorphic parity test over any type with an 'integral' instance: true if the argument is divisible by 2 (i.e. x mod 2 = 0), false otherwise.",+ "Total on all integral inputs including negative numbers and signed minBound (parity is preserved by two's-complement wraparound).",+ "Requires an 'integral' type-class constraint on the argument type.",+ "Corresponds to Haskell's even :: Integral a => a -> Bool."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "integral")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "x"),- Typing.parameterDescription = (Just "the integer to test for evenness"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterDescription = (Just "the value to test for evenness"),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing, Typing.resultType = (Core.TypeLiteral Core.LiteralTypeBoolean)}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True,- Packaging.primitiveDefinitionDefaultImplementation = (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.withDefault")),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),- Core.applicationArgument = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermApplication (Core.Application {- Core.applicationFunction = (Core.TermVariable (Core.Name "hydra.lib.math.mod")),- Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))}))}))})),- Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}+ Packaging.primitiveDefinitionDefaultImplementation = Nothing} exp :: Packaging.PrimitiveDefinition exp =@@ -612,29 +649,34 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.mod"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Integer modulus, or Nothing if dividing by zero."),+ Packaging.entityMetadataDescription = (Just "Integral modulus, or Nothing if dividing by zero."), Packaging.entityMetadataComments = [- "Total integer modulus: mod(x, y) returns Just(x mod y) when y is non-zero, and Nothing when y = 0.",+ "Constraint-polymorphic total integer modulus over any type with an 'integral' instance: mod(x, y) returns Just(x mod y) when y is non-zero, and Nothing when y = 0.", "The result satisfies the identity x = (div(x, y) result) * y + (mod(x, y) result), so the sign of the result matches the sign of y (Knuth-style floor division). For example mod(-7, 2) = Just(1).",- "Corresponds to Haskell's mod :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."],+ "Requires an 'integral' type-class constraint on the argument type.",+ "Corresponds to Haskell's mod :: Integral a => a -> a -> a, wrapped in maybe to make the zero-divisor case total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "integral")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "x"), Typing.parameterDescription = (Just "the dividend"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "y"), Typing.parameterDescription = (Just "the divisor"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing,- Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}},+ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing}@@ -769,19 +811,24 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.odd"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Test whether an integer is odd."),+ Packaging.entityMetadataDescription = (Just "Test whether a value is odd."), Packaging.entityMetadataComments = [- "True if the argument is not divisible by 2 (i.e. x mod 2 \8800 0), false otherwise.",- "Total on all int32 inputs including negative numbers and minBound. Corresponds to Haskell's odd :: Int32 -> Bool."],+ "Constraint-polymorphic parity test over any type with an 'integral' instance: true if the argument is not divisible by 2 (i.e. x mod 2 \8800 0), false otherwise.",+ "Total on all integral inputs including negative numbers and signed minBound. Requires an 'integral' type-class constraint on the argument type.",+ "Corresponds to Haskell's odd :: Integral a => a -> Bool."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "integral")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "x"),- Typing.parameterDescription = (Just "the integer to test for oddness"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterDescription = (Just "the value to test for oddness"),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing,@@ -886,30 +933,35 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.rem"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Integer remainder, or Nothing if dividing by zero."),+ Packaging.entityMetadataDescription = (Just "Integral remainder, or Nothing if dividing by zero."), Packaging.entityMetadataComments = [- "Total integer remainder: rem(x, y) returns Just(x rem y) when y is non-zero, and Nothing when y = 0.",+ "Constraint-polymorphic total integer remainder over any type with an 'integral' instance: rem(x, y) returns Just(x rem y) when y is non-zero, and Nothing when y = 0.", "The result satisfies x = (truncate(x / y)) * y + (rem(x, y) result), so the sign of the result matches the sign of x (truncated division, C-style remainder). For example rem(-7, 2) = Just(-1).",- "The boundary case rem(minBound, -1) is 0 (no overflow, since the quotient overflow is absorbed).",- "Corresponds to Haskell's rem :: Int32 -> Int32 -> Int32, wrapped in maybe to make the zero-divisor case total."],+ "For fixed-width signed integers, the boundary case rem(minBound, -1) is 0 (no overflow, since the quotient overflow is absorbed by div, not rem).",+ "Requires an 'integral' type-class constraint on the argument type.",+ "Corresponds to Haskell's rem :: Integral a => a -> a -> a, wrapped in maybe to make the zero-divisor case total."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "integral")]}], Typing.termSignatureParameters = [ Typing.Parameter { Typing.parameterName = (Core.Name "x"), Typing.parameterDescription = (Just "the dividend"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}, Typing.Parameter { Typing.parameterName = (Core.Name "y"), Typing.parameterDescription = (Just "the divisor"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ Typing.parameterType = (Core.TypeVariable (Core.Name "x")), Typing.parameterIsLazy = False}], Typing.termSignatureResult = Typing.Result { Typing.resultDescription = Nothing,- Typing.resultType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}},+ Typing.resultType = (Core.TypeOptional (Core.TypeVariable (Core.Name "x")))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing}@@ -1010,24 +1062,29 @@ Packaging.PrimitiveDefinition { Packaging.primitiveDefinitionName = (Core.Name "hydra.lib.math.signum"), Packaging.primitiveDefinitionMetadata = (Just (Packaging.EntityMetadata {- Packaging.entityMetadataDescription = (Just "Return the sign of an integer as -1, 0, or 1."),+ Packaging.entityMetadataDescription = (Just "Numeric sign."), Packaging.entityMetadataComments = [- "signum(x) returns -1 if x < 0, 0 if x = 0, and 1 if x > 0.",- "The function is total and satisfies the identity abs(x) * signum(x) = x for all int32 except minBound (where abs(minBound) * (-1) wraps to minBound rather than equalling -minBound, since +2147483648 is not representable).",- "Corresponds to Haskell's signum :: Int32 -> Int32."],+ "Constraint-polymorphic sign function over any type with a 'numeric' instance. For integer types, signum(x) returns -1 if x < 0, 0 if x = 0, and 1 if x > 0 (same width as the argument); unsigned integers return only 0 or 1. The function satisfies abs(x) * signum(x) = x for all integer instances except signed minBound (where the identity fails because +maxBound+1 is not representable).",+ "For floating-point, signum(x) returns \2833.0 for nonzero finite or infinite x (per IEEE 754 \2677.5.1); signum(\2832) = \2832 (the sign of the input zero is preserved, not collapsed to a single zero); signum(NaN) is NaN. A naive three-branch implementation (positive/negative/else- zero) gets both of these float cases wrong and must not be used.",+ "Requires a 'numeric' type-class constraint on the argument type.",+ "Corresponds to Haskell's signum :: Num a => a -> a."], Packaging.entityMetadataSeeAlso = [], Packaging.entityMetadataLifecycle = Nothing})), Packaging.primitiveDefinitionSignature = Typing.TermSignature {- Typing.termSignatureTypeParameters = [],+ Typing.termSignatureTypeParameters = [+ Typing.TypeParameter {+ Typing.typeParameterName = (Core.Name "x"),+ Typing.typeParameterConstraints = [+ Core.TypeClassConstraintSimple (Core.Name "numeric")]}], Typing.termSignatureParameters = [ Typing.Parameter {- Typing.parameterName = (Core.Name "x"),- Typing.parameterDescription = (Just "the integer whose sign is returned"),- Typing.parameterType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+ 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.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}},+ Typing.resultType = (Core.TypeVariable (Core.Name "x"))}}, Packaging.primitiveDefinitionIsPure = True, Packaging.primitiveDefinitionIsTotal = True, Packaging.primitiveDefinitionDefaultImplementation = Nothing}
src/main/haskell/Hydra/Overlay/Haskell/Lib/Math.hs view
@@ -3,8 +3,9 @@ module Hydra.Overlay.Haskell.Lib.Math where -import Prelude (Num, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), String, (.), ($), (+), (-), (*), (==), (||))+import Prelude (Num, Fractional, Ord, Integral, Enum, Bool, Double, Int, Integer, Float, Maybe(..), String, (.), ($), (+), (-), (*), (/), (==), (||)) import qualified Prelude+import qualified Data.Int as I import qualified Hydra.Core as Core @@ -69,6 +70,13 @@ cosh :: Double -> Double cosh = Prelude.cosh +-- | Divide two numbers (native call contract; monomorphized at Float or Double by the+-- caller). IEEE 754 total division: GHC's Fractional (/) already produces the IEEE+-- sentinels (±Infinity, NaN) for both Float and Double, so no special-casing is needed+-- here (cf. add/sub/mul, which are also directly the Prelude class method).+divide :: Fractional a => a -> a -> a+divide x y = x / y+ -- | Euler's number (e ≈ 2.71828). e :: Double e = Prelude.exp 1.0@@ -221,14 +229,47 @@ -- These implementations back the polymorphic add/sub/mul/negate primitives, which are -- registered with identity (Term) coders (see Hydra.Overlay.Haskell.Libraries) so that the -- runtime numeric type is discovered by dispatching on the argument's literal variant. Each--- variant delegates to Haskell's Num instance for the underlying representation type, which--- gives the correct per-type semantics for free: two's-complement wraparound for the--- fixed-width integer types, arbitrary precision for bigint, and IEEE 754 for the floats.+-- variant delegates to Haskell's Num instance for the underlying representation type, then+-- (for int32/uint8/uint16/uint32/uint64, whose IntegerValue payload is an oversized container+-- rather than a matching fixed-width type — see Hydra.Core's IntegerValueInt32 :: Int,+-- IntegerValueUint32 :: I.Int64, etc.) explicitly re-narrows the result to the nominal bit+-- width. int8/int16/int64 use exactly-sized containers (I.Int8/I.Int16/I.Int64) and get+-- two's-complement wraparound for free from GHC's Num instance; bigint is unbounded by design.+-- Without the explicit narrowing, e.g. abs(minBound::int32) or (maxBound + maxBound :: uint8)+-- silently escape their nominal range instead of wrapping. -- -- Type inference guarantees both operands of a binary op share one 'numeric' type, so the -- dispatch keys on the first operand and requires the second to match; a mismatch or a -- non-numeric literal is an internal invariant violation and fails loudly. +-- | Narrow a container-typed intermediate result back to the nominal signed bit width+-- (two's-complement wraparound: mask to 2^bits, then re-center into the signed range).+wrapSigned :: Prelude.Integer -> Prelude.Integer -> Prelude.Integer+wrapSigned bits raw =+ let m = (2 :: Prelude.Integer) Prelude.^ bits+ halfM = m `Prelude.div` 2+ masked = raw `Prelude.mod` m+ in if masked Prelude.>= halfM then masked Prelude.- m else masked++-- | Narrow a container-typed intermediate result back to the nominal unsigned bit width.+wrapUnsigned :: Prelude.Integer -> Prelude.Integer -> Prelude.Integer+wrapUnsigned bits raw = raw `Prelude.mod` ((2 :: Prelude.Integer) Prelude.^ bits)++wrapInt32 :: Int -> Int+wrapInt32 raw = Prelude.fromIntegral (wrapSigned 32 (Prelude.toInteger raw))++wrapUint8 :: I.Int16 -> I.Int16+wrapUint8 raw = Prelude.fromIntegral (wrapUnsigned 8 (Prelude.toInteger raw))++wrapUint16 :: Int -> Int+wrapUint16 raw = Prelude.fromIntegral (wrapUnsigned 16 (Prelude.toInteger raw))++wrapUint32 :: I.Int64 -> I.Int64+wrapUint32 raw = Prelude.fromIntegral (wrapUnsigned 32 (Prelude.toInteger raw))++wrapUint64 :: Prelude.Integer -> Prelude.Integer+wrapUint64 = wrapUnsigned 64+ -- | Apply a Num-polymorphic binary operation to two numeric terms, dispatching on the runtime -- integer/float variant. numericBinary :: String -> (forall a. Num a => a -> a -> a) -> Core.Term -> Core.Term -> Core.Term@@ -257,12 +298,12 @@ (Core.IntegerValueBigint a, Core.IntegerValueBigint b) -> Core.IntegerValueBigint (op a b) (Core.IntegerValueInt8 a, Core.IntegerValueInt8 b) -> Core.IntegerValueInt8 (op a b) (Core.IntegerValueInt16 a, Core.IntegerValueInt16 b) -> Core.IntegerValueInt16 (op a b)- (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) -> Core.IntegerValueInt32 (op a b)+ (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) -> Core.IntegerValueInt32 (wrapInt32 (op a b)) (Core.IntegerValueInt64 a, Core.IntegerValueInt64 b) -> Core.IntegerValueInt64 (op a b)- (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) -> Core.IntegerValueUint8 (op a b)- (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) -> Core.IntegerValueUint16 (op a b)- (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) -> Core.IntegerValueUint32 (op a b)- (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) -> Core.IntegerValueUint64 (op a b)+ (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) -> Core.IntegerValueUint8 (wrapUint8 (op a b))+ (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) -> Core.IntegerValueUint16 (wrapUint16 (op a b))+ (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) -> Core.IntegerValueUint32 (wrapUint32 (op a b))+ (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) -> Core.IntegerValueUint64 (wrapUint64 (op a b)) _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": integer operands differ in precision" integerUnary :: (forall a. Num a => a -> a) -> Core.IntegerValue -> Core.IntegerValue@@ -270,12 +311,12 @@ Core.IntegerValueBigint a -> Core.IntegerValueBigint (op a) Core.IntegerValueInt8 a -> Core.IntegerValueInt8 (op a) Core.IntegerValueInt16 a -> Core.IntegerValueInt16 (op a)- Core.IntegerValueInt32 a -> Core.IntegerValueInt32 (op a)+ Core.IntegerValueInt32 a -> Core.IntegerValueInt32 (wrapInt32 (op a)) Core.IntegerValueInt64 a -> Core.IntegerValueInt64 (op a)- Core.IntegerValueUint8 a -> Core.IntegerValueUint8 (op a)- Core.IntegerValueUint16 a -> Core.IntegerValueUint16 (op a)- Core.IntegerValueUint32 a -> Core.IntegerValueUint32 (op a)- Core.IntegerValueUint64 a -> Core.IntegerValueUint64 (op a)+ Core.IntegerValueUint8 a -> Core.IntegerValueUint8 (wrapUint8 (op a))+ Core.IntegerValueUint16 a -> Core.IntegerValueUint16 (wrapUint16 (op a))+ Core.IntegerValueUint32 a -> Core.IntegerValueUint32 (wrapUint32 (op a))+ Core.IntegerValueUint64 a -> Core.IntegerValueUint64 (wrapUint64 (op a)) floatBinary :: String -> (forall a. Num a => a -> a -> a) -> Core.FloatValue -> Core.FloatValue -> Core.FloatValue floatBinary opName op fx fy = case (fx, fy) of@@ -303,3 +344,164 @@ -- | Polymorphic negation over numeric terms. negateTerm :: Core.Term -> Core.Term negateTerm = numericUnary "negate" Prelude.negate++-- | Polymorphic absolute value over numeric terms.+absTerm :: Core.Term -> Core.Term+absTerm = numericUnary "abs" Prelude.abs++-- | Polymorphic sign function over numeric terms.+signumTerm :: Core.Term -> Core.Term+signumTerm = numericUnary "signum" Prelude.signum++-- Constraint-polymorphic ('fractional') division over raw terms.+--+-- This implementation backs the polymorphic divide primitive, which is registered with an+-- identity (Term) coder (see Hydra.Overlay.Haskell.Libraries) so that the runtime float type+-- is discovered by dispatching on the argument's literal variant. Both arms delegate to+-- GHC's Fractional (/) for the underlying representation type (Float or Double), which+-- already produces the IEEE 754 sentinels (±Infinity, NaN) for free.+--+-- Type inference guarantees both operands share one 'fractional' type, so the dispatch keys+-- on the first operand and requires the second to match; a mismatch or a non-float literal+-- is an internal invariant violation and fails loudly (same discipline as numericBinary).++-- | Apply divide to two float terms, dispatching on the runtime float32/float64 variant.+divideTerm :: Core.Term -> Core.Term -> Core.Term+divideTerm x y = case (fractionalLiteral x, fractionalLiteral y) of+ (Core.LiteralFloat fx, Core.LiteralFloat fy) ->+ Core.TermLiteral $ Core.LiteralFloat $ floatDivide fx fy+ _ -> Prelude.error "hydra.lib.math.divide: operands are not the same fractional kind"++-- | Extract the literal from a term, failing loudly on any non-literal term.+fractionalLiteral :: Core.Term -> Core.Literal+fractionalLiteral term = case term of+ Core.TermLiteral lit -> lit+ _ -> Prelude.error "hydra.lib.math.divide: expected a literal term"++floatDivide :: Core.FloatValue -> Core.FloatValue -> Core.FloatValue+floatDivide fx fy = case (fx, fy) of+ (Core.FloatValueFloat32 a, Core.FloatValueFloat32 b) -> Core.FloatValueFloat32 (divide a b)+ (Core.FloatValueFloat64 a, Core.FloatValueFloat64 b) -> Core.FloatValueFloat64 (divide a b)+ _ -> Prelude.error "hydra.lib.math.divide: float operands differ in precision"++-- Constraint-polymorphic ('integral') division/modulus/remainder/parity over raw terms.+--+-- These implementations back the polymorphic div/mod/rem/even primitives, registered with+-- identity (Term) coders (see Hydra.Overlay.Haskell.Libraries) so the runtime integer type+-- is discovered by dispatching on the argument's literal variant. div/mod are floor-based+-- (sign follows the divisor); rem is truncated (sign follows the dividend) — this matches+-- GHC's own div/mod vs quot/rem split. Both dispatch families guard the zero-divisor case+-- (returning Nothing) BEFORE calling the underlying Integral operation.+--+-- The (minBound, -1) boundary needs an explicit guard on div only: GHC's div/quot for+-- Int8/Int16/Int32/Int64 throw "arithmetic overflow" there (the quotient +maxBound+1 is not+-- representable), while mod/rem do NOT trap (Haskell special-cases them to 0 at that point,+-- since no overflow occurs in the remainder). Guarding div wraps the quotient to minBound,+-- matching the two's-complement contract (design round4 finding E1). Bigint/uint has no such+-- boundary (unbounded / no negative domain).++-- | Apply floor division to two integer terms, dispatching on the runtime integer variant.+divTerm :: Core.Term -> Core.Term -> Maybe Core.Term+divTerm x y = case (integralLiteral "div" x, integralLiteral "div" y) of+ (Core.IntegerValueBigint a, Core.IntegerValueBigint b) ->+ integralResult $ Core.IntegerValueBigint Prelude.<$> maybeDivBounded Prelude.Nothing a b+ (Core.IntegerValueInt8 a, Core.IntegerValueInt8 b) ->+ integralResult $ Core.IntegerValueInt8 Prelude.<$> maybeDivBounded (Prelude.Just (Prelude.minBound, -1)) a b+ (Core.IntegerValueInt16 a, Core.IntegerValueInt16 b) ->+ integralResult $ Core.IntegerValueInt16 Prelude.<$> maybeDivBounded (Prelude.Just (Prelude.minBound, -1)) a b+ (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) ->+ integralResult $ Core.IntegerValueInt32 Prelude.<$> maybeDivBounded (Prelude.Just (-2147483648, -1)) a b+ (Core.IntegerValueInt64 a, Core.IntegerValueInt64 b) ->+ integralResult $ Core.IntegerValueInt64 Prelude.<$> maybeDivBounded (Prelude.Just (Prelude.minBound, -1)) a b+ (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) ->+ integralResult $ Core.IntegerValueUint8 Prelude.<$> maybeDivBounded Prelude.Nothing a b+ (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) ->+ integralResult $ Core.IntegerValueUint16 Prelude.<$> maybeDivBounded Prelude.Nothing a b+ (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) ->+ integralResult $ Core.IntegerValueUint32 Prelude.<$> maybeDivBounded Prelude.Nothing a b+ (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) ->+ integralResult $ Core.IntegerValueUint64 Prelude.<$> maybeDivBounded Prelude.Nothing a b+ _ -> Prelude.error "hydra.lib.math.div: integer operands differ in precision"++-- | div, guarded against the zero-divisor case and (when a boundary pair is given) the+-- minBound/-1 overflow case, which is wrapped rather than left to trap.+maybeDivBounded :: (Integral a) => Maybe (a, a) -> a -> a -> Maybe a+maybeDivBounded boundary x y+ | y Prelude.== 0 = Prelude.Nothing+ | Prelude.Just (mn, negOne) <- boundary, x Prelude.== mn, y Prelude.== negOne = Prelude.Just mn+ | Prelude.otherwise = Prelude.Just (Prelude.div x y)++-- | Apply floor modulus to two integer terms, dispatching on the runtime integer variant.+modTerm :: Core.Term -> Core.Term -> Maybe Core.Term+modTerm x y = case (integralLiteral "mod" x, integralLiteral "mod" y) of+ (Core.IntegerValueBigint a, Core.IntegerValueBigint b) -> integralResult $ Core.IntegerValueBigint Prelude.<$> maybeMod a b+ (Core.IntegerValueInt8 a, Core.IntegerValueInt8 b) -> integralResult $ Core.IntegerValueInt8 Prelude.<$> maybeMod a b+ (Core.IntegerValueInt16 a, Core.IntegerValueInt16 b) -> integralResult $ Core.IntegerValueInt16 Prelude.<$> maybeMod a b+ (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) -> integralResult $ Core.IntegerValueInt32 Prelude.<$> maybeMod a b+ (Core.IntegerValueInt64 a, Core.IntegerValueInt64 b) -> integralResult $ Core.IntegerValueInt64 Prelude.<$> maybeMod a b+ (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) -> integralResult $ Core.IntegerValueUint8 Prelude.<$> maybeMod a b+ (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) -> integralResult $ Core.IntegerValueUint16 Prelude.<$> maybeMod a b+ (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) -> integralResult $ Core.IntegerValueUint32 Prelude.<$> maybeMod a b+ (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) -> integralResult $ Core.IntegerValueUint64 Prelude.<$> maybeMod a b+ _ -> Prelude.error "hydra.lib.math.mod: integer operands differ in precision"++maybeMod :: (Integral a) => a -> a -> Maybe a+maybeMod x y+ | y Prelude.== 0 = Prelude.Nothing+ | Prelude.otherwise = Prelude.Just (Prelude.mod x y)++-- | Apply truncated remainder to two integer terms, dispatching on the runtime integer variant.+remTerm :: Core.Term -> Core.Term -> Maybe Core.Term+remTerm x y = case (integralLiteral "rem" x, integralLiteral "rem" y) of+ (Core.IntegerValueBigint a, Core.IntegerValueBigint b) -> integralResult $ Core.IntegerValueBigint Prelude.<$> maybeRem a b+ (Core.IntegerValueInt8 a, Core.IntegerValueInt8 b) -> integralResult $ Core.IntegerValueInt8 Prelude.<$> maybeRem a b+ (Core.IntegerValueInt16 a, Core.IntegerValueInt16 b) -> integralResult $ Core.IntegerValueInt16 Prelude.<$> maybeRem a b+ (Core.IntegerValueInt32 a, Core.IntegerValueInt32 b) -> integralResult $ Core.IntegerValueInt32 Prelude.<$> maybeRem a b+ (Core.IntegerValueInt64 a, Core.IntegerValueInt64 b) -> integralResult $ Core.IntegerValueInt64 Prelude.<$> maybeRem a b+ (Core.IntegerValueUint8 a, Core.IntegerValueUint8 b) -> integralResult $ Core.IntegerValueUint8 Prelude.<$> maybeRem a b+ (Core.IntegerValueUint16 a, Core.IntegerValueUint16 b) -> integralResult $ Core.IntegerValueUint16 Prelude.<$> maybeRem a b+ (Core.IntegerValueUint32 a, Core.IntegerValueUint32 b) -> integralResult $ Core.IntegerValueUint32 Prelude.<$> maybeRem a b+ (Core.IntegerValueUint64 a, Core.IntegerValueUint64 b) -> integralResult $ Core.IntegerValueUint64 Prelude.<$> maybeRem a b+ _ -> Prelude.error "hydra.lib.math.rem: integer operands differ in precision"++maybeRem :: (Integral a) => a -> a -> Maybe a+maybeRem x y+ | y Prelude.== 0 = Prelude.Nothing+ | Prelude.otherwise = Prelude.Just (Prelude.rem x y)++-- | Apply a parity test to an integer term, dispatching on the runtime integer variant.+evenTerm :: Core.Term -> Bool+evenTerm x = case integralLiteral "even" x of+ Core.IntegerValueBigint a -> Prelude.even a+ Core.IntegerValueInt8 a -> Prelude.even a+ Core.IntegerValueInt16 a -> Prelude.even a+ Core.IntegerValueInt32 a -> Prelude.even a+ Core.IntegerValueInt64 a -> Prelude.even a+ Core.IntegerValueUint8 a -> Prelude.even a+ Core.IntegerValueUint16 a -> Prelude.even a+ Core.IntegerValueUint32 a -> Prelude.even a+ Core.IntegerValueUint64 a -> Prelude.even a++-- | Apply a parity test (odd) to an integer term, dispatching on the runtime integer variant.+oddTerm :: Core.Term -> Bool+oddTerm x = case integralLiteral "odd" x of+ Core.IntegerValueBigint a -> Prelude.odd a+ Core.IntegerValueInt8 a -> Prelude.odd a+ Core.IntegerValueInt16 a -> Prelude.odd a+ Core.IntegerValueInt32 a -> Prelude.odd a+ Core.IntegerValueInt64 a -> Prelude.odd a+ Core.IntegerValueUint8 a -> Prelude.odd a+ Core.IntegerValueUint16 a -> Prelude.odd a+ Core.IntegerValueUint32 a -> Prelude.odd a+ Core.IntegerValueUint64 a -> Prelude.odd a++-- | Extract the integer value from a term, failing loudly on any non-integer literal term.+integralLiteral :: String -> Core.Term -> Core.IntegerValue+integralLiteral opName term = case term of+ Core.TermLiteral (Core.LiteralInteger iv) -> iv+ _ -> Prelude.error $ "hydra.lib.math." Prelude.++ opName Prelude.++ ": expected an integer literal term"++-- | Wrap a Maybe integer result as a Term-encoded optional integer literal.+integralResult :: Maybe Core.IntegerValue -> Maybe Core.Term+integralResult Prelude.Nothing = Prelude.Nothing+integralResult (Prelude.Just iv) = Prelude.Just (Core.TermLiteral (Core.LiteralInteger iv))
src/main/haskell/Hydra/Overlay/Haskell/Libraries.hs view
@@ -326,6 +326,10 @@ prim1 DefMath.ceiling Math.ceiling float64 float64, prim1 DefMath.cos Math.cos float64 float64, prim1 DefMath.cosh Math.cosh float64 float64,+ -- Constraint-polymorphic ('fractional') division: registered once with identity (Term)+ -- coders so the implementation dispatches on the argument's runtime float type (float32+ -- or float64; see Math.divideTerm). Mirrors #566's numeric-class registration pattern.+ prim2 DefMath.divide Math.divideTerm x_ x_ x_, prim0 DefMath.e Math.e float64, prim1 DefMath.exp Math.exp float64 float64, prim1 DefMath.floor Math.floor float64 float64,@@ -348,17 +352,20 @@ hydraLibMathInt32 :: Library hydraLibMathInt32 = standardLibrary [- prim1 DefMath.abs Math.abs int32 int32,+ -- Constraint-polymorphic ('numeric'/'integral') primitives: registered once with identity+ -- (Term) coders so the implementation dispatches on the argument's runtime type (see+ -- Math.*Term). Mirrors #566's numeric-class registration pattern.+ prim1 DefMath.abs Math.absTerm x_ x_, prim2 DefMath.add Math.addTerm x_ x_ x_,- prim1 DefMath.even Math.even int32 boolean,- prim2 DefMath.div Math.div int32 int32 (optional int32),- prim2 DefMath.mod Math.mod int32 int32 (optional int32),+ prim1 DefMath.even Math.evenTerm x_ boolean,+ prim2 DefMath.div Math.divTerm x_ x_ (optional x_),+ prim2 DefMath.mod Math.modTerm x_ x_ (optional x_), prim2 DefMath.mul Math.mulTerm x_ x_ x_, prim1 DefMath.negate Math.negateTerm x_ x_,- prim1 DefMath.odd Math.odd int32 boolean,+ prim1 DefMath.odd Math.oddTerm x_ boolean, prim2 DefMath.range Math.range int32 int32 (list int32),- prim2 DefMath.rem Math.rem int32 int32 (optional int32),- prim1 DefMath.signum Math.signum int32 int32,+ prim2 DefMath.rem Math.remTerm x_ x_ (optional x_),+ prim1 DefMath.signum Math.signumTerm x_ x_, prim2 DefMath.sub Math.subTerm x_ x_ x_] hydraLibOptionals :: Library
src/main/haskell/Hydra/Print/Error/Core.hs view
@@ -107,6 +107,18 @@ emptyUnionTypeError :: t0 -> String emptyUnionTypeError e = "union type with no alternatives (use TypeVoid instead)" +-- | Show an extra record fields error as a string+extraRecordFieldsError :: ErrorCore.ExtraRecordFieldsError -> String+extraRecordFieldsError e =++ let tname = ErrorCore.extraRecordFieldsErrorTypeName e+ fieldNames = ErrorCore.extraRecordFieldsErrorFieldNames e+ in (Strings.concat [+ "record term for type ",+ (Core.unName tname),+ " supplies undeclared field(s): ",+ (Strings.join ", " (Lists.map Core.unName fieldNames))])+ -- | Show an invalid forall parameter name error as a string invalidForallParameterNameError :: ErrorCore.InvalidForallParameterNameError -> String invalidForallParameterNameError e =@@ -139,22 +151,28 @@ ErrorCore.InvalidTermErrorEmptyLetBindings v0 -> emptyLetBindingsError v0 ErrorCore.InvalidTermErrorEmptyTermAnnotation v0 -> emptyTermAnnotationError v0 ErrorCore.InvalidTermErrorEmptyTypeNameInTerm v0 -> emptyTypeNameInTermError v0+ ErrorCore.InvalidTermErrorExtraRecordFields v0 -> extraRecordFieldsError v0 ErrorCore.InvalidTermErrorInvalidLambdaParameterName v0 -> invalidLambdaParameterNameError v0 ErrorCore.InvalidTermErrorInvalidLetBindingName v0 -> invalidLetBindingNameError v0 ErrorCore.InvalidTermErrorInvalidTypeLambdaParameterName v0 -> invalidTypeLambdaParameterNameError v0 ErrorCore.InvalidTermErrorMissingCaseBranches v0 -> missingCaseBranchesError v0+ ErrorCore.InvalidTermErrorMissingRecordFields v0 -> missingRecordFieldsError v0 ErrorCore.InvalidTermErrorNestedTermAnnotation v0 -> nestedTermAnnotationError v0+ ErrorCore.InvalidTermErrorNominalTypeKindMismatch v0 -> nominalTypeKindMismatchError v0 ErrorCore.InvalidTermErrorRedundantWrapUnwrap v0 -> redundantWrapUnwrapError v0 ErrorCore.InvalidTermErrorSelfApplication v0 -> selfApplicationError v0 ErrorCore.InvalidTermErrorTermVariableShadowing v0 -> termVariableShadowingError v0 ErrorCore.InvalidTermErrorTypeVariableShadowingInTypeLambda v0 -> typeVariableShadowingInTypeLambdaError v0+ ErrorCore.InvalidTermErrorUndeclaredVariant v0 -> undeclaredVariantError v0 ErrorCore.InvalidTermErrorUndefinedTermVariable v0 -> undefinedTermVariableError v0 ErrorCore.InvalidTermErrorUndefinedTypeVariableInBindingType v0 -> undefinedTypeVariableInBindingTypeError v0 ErrorCore.InvalidTermErrorUndefinedTypeVariableInLambdaDomain v0 -> undefinedTypeVariableInLambdaDomainError v0 ErrorCore.InvalidTermErrorUndefinedTypeVariableInTypeApplication v0 -> undefinedTypeVariableInTypeApplicationError v0 ErrorCore.InvalidTermErrorUnknownCaseAlternative v0 -> unknownCaseAlternativeError v0 ErrorCore.InvalidTermErrorUnknownPrimitiveName v0 -> unknownPrimitiveNameError v0+ ErrorCore.InvalidTermErrorUnknownProjectedField v0 -> unknownProjectedFieldError v0 ErrorCore.InvalidTermErrorUnnecessaryIdentityApplication v0 -> unnecessaryIdentityApplicationError v0+ ErrorCore.InvalidTermErrorUnresolvedNominalType v0 -> unresolvedNominalTypeError v0 ErrorCore.InvalidTermErrorUntypedTermVariable v0 -> untypedTermVariableError v0) -- | Show an invalid type error as a string@@ -202,6 +220,18 @@ " does not cover variant(s): ", (Strings.join ", " (Lists.map Core.unName variantNames))]) +-- | Show a missing record fields error as a string+missingRecordFieldsError :: ErrorCore.MissingRecordFieldsError -> String+missingRecordFieldsError e =++ let tname = ErrorCore.missingRecordFieldsErrorTypeName e+ fieldNames = ErrorCore.missingRecordFieldsErrorFieldNames e+ in (Strings.concat [+ "record term for type ",+ (Core.unName tname),+ " is missing declared field(s): ",+ (Strings.join ", " (Lists.map Core.unName fieldNames))])+ -- | Show a nested term annotation error as a string nestedTermAnnotationError :: t0 -> String nestedTermAnnotationError e = "nested term annotations should be merged"@@ -210,6 +240,22 @@ nestedTypeAnnotationError :: t0 -> String nestedTypeAnnotationError e = "nested type annotations should be merged" +-- | Show a nominal type kind mismatch error as a string+nominalTypeKindMismatchError :: ErrorCore.NominalTypeKindMismatchError -> String+nominalTypeKindMismatchError e =++ let tname = ErrorCore.nominalTypeKindMismatchErrorTypeName e+ expected = ErrorCore.nominalTypeKindMismatchErrorExpectedVariant e+ actual = ErrorCore.nominalTypeKindMismatchErrorActualVariant e+ in (Strings.concat [+ "type name ",+ (Core.unName tname),+ " is expected to be a ",+ (PrintVariants.typeVariant expected),+ " type, but resolves to a ",+ (PrintVariants.typeVariant actual),+ " type"])+ -- | Show a non-comparable map key type error as a string nonComparableMapKeyTypeError :: ErrorCore.NonComparableMapKeyTypeError -> String nonComparableMapKeyTypeError e =@@ -266,6 +312,18 @@ "type variable shadowing in type lambda: ", (Core.unName (ErrorCore.typeVariableShadowingInTypeLambdaErrorName e))] +-- | Show an undeclared variant error as a string+undeclaredVariantError :: ErrorCore.UndeclaredVariantError -> String+undeclaredVariantError e =++ let tname = ErrorCore.undeclaredVariantErrorTypeName e+ vname = ErrorCore.undeclaredVariantErrorVariantName e+ in (Strings.concat [+ "injected variant ",+ (Core.unName vname),+ " is not declared by union type ",+ (Core.unName tname)])+ -- | Show an undefined field error as a string undefinedFieldError :: ErrorCore.UndefinedFieldError -> String undefinedFieldError e =@@ -357,9 +415,28 @@ "unknown primitive: ", (Core.unName (ErrorCore.unknownPrimitiveNameErrorName e))] +-- | Show an unknown projected field error as a string+unknownProjectedFieldError :: ErrorCore.UnknownProjectedFieldError -> String+unknownProjectedFieldError e =++ let tname = ErrorCore.unknownProjectedFieldErrorTypeName e+ fname = ErrorCore.unknownProjectedFieldErrorFieldName e+ in (Strings.concat [+ "projected field ",+ (Core.unName fname),+ " is not declared by record type ",+ (Core.unName tname)])+ -- | Show an unnecessary identity application error as a string unnecessaryIdentityApplicationError :: t0 -> String unnecessaryIdentityApplicationError e = "unnecessary application of identity lambda"++-- | Show an unresolved nominal type error as a string+unresolvedNominalTypeError :: ErrorCore.UnresolvedNominalTypeError -> String+unresolvedNominalTypeError e =+ Strings.concat [+ "type name does not resolve to any declared type: ",+ (Core.unName (ErrorCore.unresolvedNominalTypeErrorTypeName e))] -- | Show an untyped term variable error as a string untypedTermVariableError :: ErrorCore.UntypedTermVariableError -> String
src/main/haskell/Hydra/Resolution.hs view
@@ -162,6 +162,15 @@ Core.typeSchemeConstraints = renamedConstraints}, cx2) +-- | Test whether a map's key type resolves to string, following aliases and wrappers. Used to decide whether a map may use the compact JSON object encoding.+mapKeyResolvesToString :: M.Map Core.Name Core.Type -> Core.Type -> Bool+mapKeyResolvesToString types keyType =+ case (resolveBaseType types keyType) of+ Core.TypeLiteral v0 -> case v0 of+ Core.LiteralTypeString -> True+ _ -> False+ _ -> False+ -- | Apply type arguments to a nominal type nominalApplication :: Core.Name -> [Core.Type] -> Core.Type nominalApplication tname args =@@ -225,6 +234,16 @@ Core.TypeUnion v0 -> Just v0 _ -> Nothing in (requireRowType cx "union" toUnion graph name)++-- | Resolve a type to its base, following annotations, type aliases (Type.variable dereferenced against the given type map), and Type.wrap bodies, transitively. An unresolvable variable name (not found in the map) is returned as-is, since the caller is in the best position to decide whether that is an error. As with hydra.sources.kernel.terms.lexical.dereferenceSchemaType, this assumes type aliases form an acyclic reference graph, as guaranteed by schema construction; a genuinely self-referential alias is not a supported input and would not terminate.+resolveBaseType :: M.Map Core.Name Core.Type -> Core.Type -> Core.Type+resolveBaseType types typ =++ let stripped = Strip.deannotateType typ+ in case stripped of+ Core.TypeVariable v0 -> Optionals.cases (Maps.lookup v0 types) stripped (\resolved -> resolveBaseType types resolved)+ Core.TypeWrap v0 -> resolveBaseType types v0+ _ -> stripped -- | Resolve a type, dereferencing type variables resolveType :: Graph.Graph -> Core.Type -> Maybe Core.Type
src/main/haskell/Hydra/Unification.hs view
@@ -137,7 +137,7 @@ -- | * Unify(∅) = I (the identity substitution x ↦ x) -- | * Unify({(x, x)} ∪ E) = Unify(E) -- | * Unify({(f(s1, ..., sn), f(t1, ..., tn))} ∪ E) = Unify({(s1, t1), ..., (sn, tn)} ∪ E))-unifyTypeConstraints :: t0 -> M.Map Core.Name t1 -> [Typing.TypeConstraint] -> Either Errors.UnificationError Typing.TypeSubst+unifyTypeConstraints :: t0 -> M.Map Core.Name Core.TypeScheme -> [Typing.TypeConstraint] -> Either Errors.UnificationError Typing.TypeSubst unifyTypeConstraints cx schemaTypes constraints = let withConstraint =@@ -155,13 +155,24 @@ Errors.unificationErrorLeftType = sleft, Errors.unificationErrorRightType = sright, Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Variable " (Core.unName v)) " appears free in type ") (PrintCore.type_ t)) " (") comment) ")")})) (bind v t)+ isNominalSchemaType =+ \ts -> case (Strip.deannotateType (Core.typeSchemeBody ts)) of+ Core.TypeRecord _ -> True+ Core.TypeUnion _ -> True+ Core.TypeWrap _ -> True+ _ -> False+ tryBindOrSchema =+ \v -> \t -> Optionals.cases (Maps.lookup v schemaTypes) (tryBinding v t) (\ts -> Logic.ifElse (isNominalSchemaType ts) (Left (Errors.UnificationError {+ Errors.unificationErrorLeftType = sleft,+ Errors.unificationErrorRightType = sright,+ Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Cannot unify schema name " (Core.unName v)) " with type ") (PrintCore.type_ t)) " (") comment) ")")})) (tryBinding v t)) noVars = let withConstraints = \constraints2 -> unifyTypeConstraints cx schemaTypes (Lists.concat2 constraints2 rest) in (Eithers.bind (joinTypes cx sleft sright comment) withConstraints) dflt = case sright of- Core.TypeVariable v0 -> tryBinding v0 sleft+ Core.TypeVariable v0 -> tryBindOrSchema v0 sleft _ -> noVars in case sleft of Core.TypeVariable v0 -> case sright of@@ -169,12 +180,12 @@ Errors.unificationErrorLeftType = sleft, Errors.unificationErrorRightType = sright, Errors.unificationErrorMessage = (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 (Strings.concat2 "Attempted to unify schema names " (Core.unName v0)) " and ") (Core.unName v1)) " (") comment) ")")})) (bind v1 sleft)) (bind v0 sright))- _ -> tryBinding v0 sright+ _ -> tryBindOrSchema 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 :: t0 -> M.Map Core.Name Core.TypeScheme -> [Core.Type] -> [Core.Type] -> String -> Either Errors.UnificationError Typing.TypeSubst unifyTypeLists cx schemaTypes l r comment = let toConstraint =@@ -185,7 +196,7 @@ 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 :: t0 -> M.Map Core.Name Core.TypeScheme -> Core.Type -> Core.Type -> String -> Either Errors.UnificationError Typing.TypeSubst unifyTypes cx schemaTypes l r comment = unifyTypeConstraints cx schemaTypes [ Typing.TypeConstraint {
src/main/haskell/Hydra/Validate/Core.hs view
@@ -180,10 +180,36 @@ Core.TermRecord v0 -> let tname = Core.recordTypeName v0 flds = Core.recordFields v0+ suppliedNames = Sets.fromList (Lists.map Core.fieldName flds)+ resolved = resolveNominalType cx tname in (firstFinding [ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError { ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing,- (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.duplicateField")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.duplicateField", f)) (checkDuplicateFields path (Lists.map Core.fieldName flds))) Nothing)])+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.duplicateField")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.duplicateField", f)) (checkDuplicateFields path (Lists.map Core.fieldName flds))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = tname}))) (\_ -> Nothing))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeRecord _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = tname,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantRecord,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.missingRecordFields")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.missingRecordFields", f)) (Optionals.cases (resolveRecordFields cx tname) Nothing (\declFields ->+ let declNames = Sets.fromList (Lists.map Core.fieldTypeName declFields)+ missing = Sets.difference declNames suppliedNames+ in (Logic.ifElse (Sets.null missing) Nothing (Just (ErrorCore.InvalidTermErrorMissingRecordFields (ErrorCore.MissingRecordFieldsError {+ ErrorCore.missingRecordFieldsErrorLocation = path,+ ErrorCore.missingRecordFieldsErrorTypeName = tname,+ ErrorCore.missingRecordFieldsErrorFieldNames = (Sets.toList missing)}))))))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.extraRecordFields")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.extraRecordFields", f)) (Optionals.cases (resolveRecordFields cx tname) Nothing (\declFields ->+ let declNames = Sets.fromList (Lists.map Core.fieldTypeName declFields)+ extra = Sets.difference suppliedNames declNames+ in (Logic.ifElse (Sets.null extra) Nothing (Just (ErrorCore.InvalidTermErrorExtraRecordFields (ErrorCore.ExtraRecordFieldsError {+ ErrorCore.extraRecordFieldsErrorLocation = path,+ ErrorCore.extraRecordFieldsErrorTypeName = tname,+ ErrorCore.extraRecordFieldsErrorFieldNames = (Sets.toList extra)}))))))) Nothing)]) Core.TermLet v0 -> let bindings = Core.letBindings v0 names = Lists.map Core.bindingName bindings@@ -200,8 +226,27 @@ ErrorCore.undefinedTypeVariableInBindingTypeErrorName = uvName}))))) bindings)) Nothing)) Nothing)]) Core.TermInject v0 -> let tname = Core.injectionTypeName v0- 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)+ variantName = Core.fieldName (Core.injectionField v0)+ resolved = resolveNominalType cx tname+ in (firstFinding [+ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError {+ ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing,+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = tname}))) (\_ -> Nothing))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeUnion _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = tname,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantUnion,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.undeclaredVariant")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.undeclaredVariant", f)) (Optionals.cases (resolveUnionFields cx tname) Nothing (\declFields ->+ let declNames = Sets.fromList (Lists.map Core.fieldTypeName declFields)+ in (Logic.ifElse (Sets.member variantName declNames) Nothing (Just (ErrorCore.InvalidTermErrorUndeclaredVariant (ErrorCore.UndeclaredVariantError {+ ErrorCore.undeclaredVariantErrorLocation = path,+ ErrorCore.undeclaredVariantErrorTypeName = tname,+ ErrorCore.undeclaredVariantErrorVariantName = variantName}))))))) Nothing)]) Core.TermLambda v0 -> let paramName = Core.lambdaParameter v0 in (firstFinding [@@ -216,17 +261,47 @@ ErrorCore.undefinedTypeVariableInLambdaDomainErrorName = uvName}))))) Nothing)) Nothing)]) Core.TermProject v0 -> let tname = Core.projectionTypeName v0- 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)+ fname = Core.projectionFieldName v0+ resolved = resolveNominalType cx tname+ in (firstFinding [+ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError {+ ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing,+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = tname}))) (\_ -> Nothing))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeRecord _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = tname,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantRecord,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unknownProjectedField")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unknownProjectedField", f)) (Optionals.cases (resolveRecordFields cx tname) Nothing (\declFields ->+ let declNames = Sets.fromList (Lists.map Core.fieldTypeName declFields)+ in (Logic.ifElse (Sets.member fname declNames) Nothing (Just (ErrorCore.InvalidTermErrorUnknownProjectedField (ErrorCore.UnknownProjectedFieldError {+ ErrorCore.unknownProjectedFieldErrorLocation = path,+ ErrorCore.unknownProjectedFieldErrorTypeName = tname,+ ErrorCore.unknownProjectedFieldErrorFieldName = fname}))))))) Nothing)]) Core.TermCases v0 -> let tname = Core.caseStatementTypeName v0 csDefault = Core.caseStatementDefault v0 csCases = Core.caseStatementCases v0 altNames = Sets.fromList (Lists.map Core.caseAlternativeName csCases) unionFields = resolveUnionFields cx tname+ resolved = resolveNominalType cx tname in (firstFinding [ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError { ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing,+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = tname}))) (\_ -> Nothing))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeUnion _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = tname,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantUnion,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing), (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyCaseStatement")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyCaseStatement", f)) (Logic.ifElse (Logic.and (Lists.null csCases) (Optionals.isNone csDefault)) (Just (ErrorCore.InvalidTermErrorEmptyCaseStatement (ErrorCore.EmptyCaseStatementError { ErrorCore.emptyCaseStatementErrorLocation = path, ErrorCore.emptyCaseStatementErrorTypeName = tname}))) Nothing)) Nothing),@@ -262,8 +337,33 @@ ErrorCore.undefinedTermVariableErrorName = v0}))))) Nothing Core.TermWrap v0 -> let tname = Core.wrappedTermTypeName v0- 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)+ resolved = resolveNominalType cx tname+ in (firstFinding [+ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm", f)) (Logic.ifElse (Equality.equal (Core.unName tname) "") (Just (ErrorCore.InvalidTermErrorEmptyTypeNameInTerm (ErrorCore.EmptyTypeNameInTermError {+ ErrorCore.emptyTypeNameInTermErrorLocation = path}))) Nothing)) Nothing,+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = tname}))) (\_ -> Nothing))) Nothing),+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeWrap _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = tname,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantWrap,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing)])+ Core.TermUnwrap v0 ->+ let resolved = resolveNominalType cx v0+ in (firstFinding [+ Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType", f)) (Optionals.cases resolved (Just (ErrorCore.InvalidTermErrorUnresolvedNominalType (ErrorCore.UnresolvedNominalTypeError {+ ErrorCore.unresolvedNominalTypeErrorLocation = path,+ ErrorCore.unresolvedNominalTypeErrorTypeName = v0}))) (\_ -> Nothing))) Nothing,+ (Logic.ifElse (enabled p (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch")) (Optionals.map (\f -> (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch", f)) (Optionals.cases resolved Nothing (\typ -> case typ of+ Core.TypeWrap _ -> Nothing+ _ -> Just (ErrorCore.InvalidTermErrorNominalTypeKindMismatch (ErrorCore.NominalTypeKindMismatchError {+ ErrorCore.nominalTypeKindMismatchErrorLocation = path,+ ErrorCore.nominalTypeKindMismatchErrorTypeName = v0,+ ErrorCore.nominalTypeKindMismatchErrorExpectedVariant = Variants.TypeVariantWrap,+ ErrorCore.nominalTypeKindMismatchErrorActualVariant = (Reflect.typeVariant typ)}))))) Nothing)]) _ -> Nothing -- | Check a type for type variables not bound in the current scope@@ -339,7 +439,7 @@ 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.+-- | The default validation profile for term and type validation, with every check classified as an error except InvalidTypeError.singleVariantUnion and InvalidTypeError.emptyRecordType (warnings); maxErrors=1, maxWarnings=20. kernelDefaultCoreProfile :: Validation.ValidationProfile kernelDefaultCoreProfile = Validation.ValidationProfile {@@ -351,26 +451,31 @@ (Core.Name "hydra.error.core.InvalidTermError.emptyLetBindings"), (Core.Name "hydra.error.core.InvalidTermError.emptyTermAnnotation"), (Core.Name "hydra.error.core.InvalidTermError.emptyTypeNameInTerm"),+ (Core.Name "hydra.error.core.InvalidTermError.extraRecordFields"), (Core.Name "hydra.error.core.InvalidTermError.invalidLambdaParameterName"), (Core.Name "hydra.error.core.InvalidTermError.invalidLetBindingName"), (Core.Name "hydra.error.core.InvalidTermError.invalidTypeLambdaParameterName"), (Core.Name "hydra.error.core.InvalidTermError.missingCaseBranches"),+ (Core.Name "hydra.error.core.InvalidTermError.missingRecordFields"), (Core.Name "hydra.error.core.InvalidTermError.nestedTermAnnotation"),+ (Core.Name "hydra.error.core.InvalidTermError.nominalTypeKindMismatch"), (Core.Name "hydra.error.core.InvalidTermError.redundantWrapUnwrap"), (Core.Name "hydra.error.core.InvalidTermError.selfApplication"), (Core.Name "hydra.error.core.InvalidTermError.termVariableShadowing"), (Core.Name "hydra.error.core.InvalidTermError.typeVariableShadowingInTypeLambda"),+ (Core.Name "hydra.error.core.InvalidTermError.undeclaredVariant"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTermVariable"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInBindingType"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInLambdaDomain"), (Core.Name "hydra.error.core.InvalidTermError.undefinedTypeVariableInTypeApplication"), (Core.Name "hydra.error.core.InvalidTermError.unknownCaseAlternative"), (Core.Name "hydra.error.core.InvalidTermError.unknownPrimitiveName"),+ (Core.Name "hydra.error.core.InvalidTermError.unknownProjectedField"), (Core.Name "hydra.error.core.InvalidTermError.unnecessaryIdentityApplication"),+ (Core.Name "hydra.error.core.InvalidTermError.unresolvedNominalType"), (Core.Name "hydra.error.core.InvalidTermError.untypedTermVariable"), (Core.Name "hydra.error.core.InvalidTypeError.duplicateRecordTypeFieldNames"), (Core.Name "hydra.error.core.InvalidTypeError.duplicateUnionTypeFieldNames"),- (Core.Name "hydra.error.core.InvalidTypeError.emptyRecordType"), (Core.Name "hydra.error.core.InvalidTypeError.emptyTypeAnnotation"), (Core.Name "hydra.error.core.InvalidTypeError.emptyUnionType"), (Core.Name "hydra.error.core.InvalidTypeError.invalidForallParameterName"),@@ -382,9 +487,24 @@ (Core.Name "hydra.error.core.InvalidTypeError.undefinedTypeVariable"), (Core.Name "hydra.error.core.InvalidTypeError.voidInNonBottomPosition")]), Validation.validationProfileWarningRules = (Sets.fromList [- Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion"]),+ Core.Name "hydra.error.core.InvalidTypeError.emptyRecordType",+ (Core.Name "hydra.error.core.InvalidTypeError.singleVariantUnion")]), Validation.validationProfileMaxErrors = 1, Validation.validationProfileMaxWarnings = 20}++-- | Resolve a type name to the annotation-stripped type it names in the current graph scope, or Nothing if it does not resolve.+resolveNominalType :: Graph.Graph -> Core.Name -> Maybe Core.Type+resolveNominalType cx tname =++ let toType = \ts -> Just (Strip.deannotateType (Core.typeSchemeBody ts))+ in (Optionals.cases (Maps.lookup tname (Graph.graphSchemaTypes cx)) (Optionals.cases (Maps.lookup tname (Graph.graphBoundTypes cx)) Nothing toType) toType)++-- | Resolve a type name to the field list of the record type it names, or Nothing if it does not resolve to a record type.+resolveRecordFields :: Graph.Graph -> Core.Name -> Maybe [Core.FieldType]+resolveRecordFields cx tname =+ Optionals.cases (resolveNominalType cx tname) Nothing (\typ -> case typ of+ Core.TypeRecord v0 -> Just v0+ _ -> Nothing) -- | Resolve a type name to the field list of the union type it names, or Nothing if it does not resolve to a union type. resolveUnionFields :: Graph.Graph -> Core.Name -> Maybe [Core.FieldType]